home *** CD-ROM | disk | FTP | other *** search
- {*****************************************************************************
- *
- * Main.pas - Phoenix Mail Language Kit MainForm
- *
- * Copyright (c) 1998-99 Michael Haller
- *
- * Author: Michael Haller
- * E-mail: michael@discountdrive.com
- * Homepage: http://www.discountdrive.com/sunrise
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation;
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
- *
- *----------------------------------------------------------------------------
- *
- * Revision history:
- *
- * DATE REV DESCRIPTION
- * ----------- --- ----------------------------------------------------------
- *
- *****************************************************************************}
-
- unit Main;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, Grids, ImgList, Menus, Buttons, Registry, ExtCtrls, ComCtrls,
- ShellAPI;
-
- type
- TMainForm = class(TForm)
- ListBox1: TListBox;
- StatusBar1: TStatusBar;
- Panel1: TPanel;
- Bevel1: TBevel;
- SpeedButton1: TSpeedButton;
- OpenDialog1: TOpenDialog;
- SaveDialog1: TSaveDialog;
- SpeedButton2: TSpeedButton;
- SpeedButton3: TSpeedButton;
- SpeedButton4: TSpeedButton;
- SpeedButton6: TSpeedButton;
- MainMenu1: TMainMenu;
- File1: TMenuItem;
- New1: TMenuItem;
- Open1: TMenuItem;
- Save1: TMenuItem;
- SaveAs1: TMenuItem;
- N1: TMenuItem;
- Exit1: TMenuItem;
- Help1: TMenuItem;
- Readme1: TMenuItem;
- SpeedButton7: TSpeedButton;
- SpeedButton8: TSpeedButton;
- FindDialog1: TFindDialog;
- Edit1: TMenuItem;
- Search1: TMenuItem;
- PageControl1: TPageControl;
- TabSheet1: TTabSheet;
- StringGrid1: TStringGrid;
- TabSheet4: TTabSheet;
- ScrollBox1: TScrollBox;
- GroupBox1: TGroupBox;
- Label3: TLabel;
- Label4: TLabel;
- Label5: TLabel;
- Edit2: TEdit;
- Label6: TLabel;
- Edit3: TEdit;
- GroupBox2: TGroupBox;
- Label7: TLabel;
- Edit4: TEdit;
- Label8: TLabel;
- Edit5: TEdit;
- TabSheet5: TTabSheet;
- Memo5: TMemo;
- procedure FormCreate(Sender: TObject);
- procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
- var CanSelect: Boolean);
- procedure SpeedButton1Click(Sender: TObject);
- procedure SpeedButton2Click(Sender: TObject);
- procedure SpeedButton3Click(Sender: TObject);
- procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
- const Value: String);
- procedure SpeedButton4Click(Sender: TObject);
- procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- procedure SpeedButton6Click(Sender: TObject);
- procedure SpeedButton7Click(Sender: TObject);
- procedure Search1Click(Sender: TObject);
- procedure FindDialog1Find(Sender: TObject);
- private
- { Private declarations }
- FFilename: String;
- procedure SetFilename(Value: String);
- public
- { Public declarations }
- Changed: Boolean;
- SearchIndex: Integer;
- function Confirmation: Boolean;
- property Filename: String read FFilename write SetFilename;
- function NewFile: Boolean;
- procedure LoadFile;
- function SaveFile: Boolean;
- function SaveFileAs: Boolean;
- function InteractWithPhoenix: Boolean;
- end;
-
- type
- TLangFileHeader = record
- IDStr: String[30];
- Version: Byte;
- Author: String[40];
- Comment: String[50];
- Created: String[10];
- NatName: String[20];
- EngName: String[20];
- LongStrCount: Byte;
- end;
-
- TLongStrEntry = record
- Len: SmallInt;
- end;
-
- TLangEntry = record
- ID: SmallInt;
- SubID: Byte;
- Len: Byte;
- end;
-
- const
- WM_GETFORMHANDLES = WM_USER + 523;
- sPXAppTitle = 'Phoenix Mail 0.92';
- sRegKey = 'Software\Michael Haller\Phoenix Mail';
- sVersion = '0.92';
-
- sNonameFile = 'Noname.lng';
- sLangCopyrightStr: String[30] = 'Phoenix Mail Language File';
-
- var
- MainForm: TMainForm;
- sTempLanguageFile: String;
- sLangFolder: String;
- sReadmeFile: String;
-
- implementation
-
- {$R *.DFM}
- {$R pxlang.res}
-
- var
- T: Text;
-
- function MakeValidDirName(Dir: String): String;
- begin
- if Dir[Length(Dir)] <> '\' then Dir := Dir+'\';
- Result := Dir;
- end;
-
- function TMainForm.Confirmation: Boolean;
- begin
- Result := True;
- if Changed = False then Exit;
- Result := False;
- Changed := False;
- case MessageDlg('Save changes to '+ExtractFilename(Filename)+'?', mtConfirmation, [mbYes,mbNo,mbCancel], 0) of
- mrYes: if SaveFile then Result := True else Changed := True;
- mrNo: Result := True;
- mrCancel: Changed := True;
- end;
- end;
-
- procedure TMainForm.SetFilename(Value: String);
- begin
- FFilename := Value;
- Caption := Application.Title + ' - '+ExtractFilename(FFilename);
- end;
-
- function TMainForm.InteractWithPhoenix: Boolean;
- var
- H: HWnd;
- I: Integer;
- S: String;
- NativeReg: TRegistry;
- begin
- Result := False;
- try
- try
- NativeReg := TRegistry.Create;
- NativeReg.OpenKey(sRegKey, True);
- sTempLanguageFile := NativeReg.ReadString('Path')+'templang.tmp';
- sLangFolder := NativeReg.ReadString('Path')+'Lang\';
- S := NativeReg.ReadString('Version');
- NativeReg.CloseKey;
- NativeReg.Free;
- if S <> sVersion then begin
- MessageDlg(sPXAppTitle+' is needed.', mtError, [mbOK], 0);
- Exit;
- end;
- H := FindWindow(nil, PChar(sPXAppTitle));
- if H = 0 then begin
- MessageDlg(sPXAppTitle+' must be running.', mtError, [mbOK], 0);
- Exit;
- end;
- Screen.Cursor := crHourGlass;
- DeleteFile(sTempLanguageFile);
- SendMessage(H, WM_GETFORMHANDLES, Handle, 0);
- for I := 0 to 4 do Application.HandleMessage;
- if FileExists(sTempLanguageFile) = False then begin
- MessageDlg(sPXAppTitle+' must be running.', mtError, [mbOK], 0);
- Screen.Cursor := crDefault;
- Exit;
- end;
- AssignFile(T, sTempLanguageFile);
- Reset(T);
-
- ReadLn(T, S);
- for I := 1 to StrToInt(S) do begin
- ReadLn(T, S);
- //Memo1.Lines.Add(S);
- end;
- ReadLn(T, S);
- for I := 1 to StrToInt(S) do begin
- ReadLn(T, S);
- //Memo3.Lines.Add(S);
- end;
-
- I := 1;
- StringGrid1.RowCount := 2;
- while not EoF(T) do begin
- StringGrid1.RowCount := StringGrid1.RowCount+1;
- ReadLn(T, S);
- StringGrid1.Cells[1,I] := S;
- ReadLn(T, S);
- ListBox1.Items.Add(S);
- ReadLn(T, S);
- StringGrid1.Cells[0,I] := S;
- Inc(I);
- end;
- StringGrid1.RowCount := StringGrid1.RowCount-1;
- StringGrid1.Row := 1;
- StringGrid1.Col := 2;
- StringGrid1.Cells[0,0] := 'ID/Property/Component';
- StringGrid1.Cells[1,0] := 'Original Text';
- StringGrid1.Cells[2,0] := 'Translated Language';
- OpenDialog1.InitialDir := sLangFolder;
- SaveDialog1.InitialDir := sLangFolder;
- Result := True;
- finally
- Screen.Cursor := crDefault;
- try
- CloseFile(T);
- except end;
- DeleteFile(sTempLanguageFile);
- Changed := False;
- end;
- except end;
- end;
-
- procedure TMainForm.FormCreate(Sender: TObject);
- begin
- Icon := Application.Icon;
- StringGrid1.ColWidths[0] := 140;
- sReadmeFile := MakeValidDirName(ExtractFilePath(Application.ExeName))+'LangKit.txt';
- Filename := sNonameFile;
- Label5.Caption := DateToStr(Date);
- Changed := False;
- end;
-
- function TMainForm.NewFile: Boolean;
- var
- I: Integer;
- begin
- Result := False;
- if Confirmation = False then Exit;
- Filename := sNonameFile;
- for I := 1 to StringGrid1.RowCount-1 do
- StringGrid1.Cells[2,I] := '';
- //Memo2.Lines.Clear;
- //Memo4.Lines.Clear;
- Changed := False;
- Result := True;
- end;
-
- function TMainForm.SaveFileAs: Boolean;
- begin
- Result := False;
- if SaveDialog1.Execute then begin
- Filename := SaveDialog1.Filename;
- Result := SaveFile;
- end;
- end;
-
- function TMainForm.SaveFile: Boolean;
- var
- I, E: Integer;
- P: PChar;
- LangEntry: TLangEntry;
- LongStrEntry: TLongStrEntry;
- LangFileHeader: TLangFileHeader;
- F: File;
- S: String[255];
- LongS: String;
- begin
- Result := False;
- if Filename = sNonameFile then begin
- if SaveDialog1.Execute then begin
- Filename := SaveDialog1.Filename;
- end else
- Exit;
- end;
- AssignFile(F, Filename);
- Rewrite(F, 1);
- FillChar(LangFileHeader, SizeOf(TLangFileHeader), 0);
- with LangFileHeader do begin
- IDStr := sLangCopyrightStr;
- Version := 1;
- Author := Edit2.Text;
- Comment := Edit3.Text;
- Created := Label5.Caption;
- NatName := Edit4.Text;
- EngName := Edit5.Text;
- LongStrCount := 2;
- end;
- BlockWrite(F, LangFileHeader, SizeOf(LangFileHeader));
- for E := 1 to 2 do begin
- LongS := '';
- {[if E = 1 then
- for I := 0 to Memo2.Lines.Count-1 do
- LongS := LongS + Memo2.Lines[I];
- if E = 2 then
- for I := 0 to Memo4.Lines.Count-1 do
- LongS := LongS + Memo4.Lines[I]; }
- GetMem(P, Length(LongS)+1);
- StrCopy(P, PChar(LongS));
- LongStrEntry.Len := Length(LongS);
- BlockWrite(F, LongStrEntry, SizeOf(TLongStrEntry));
- BlockWrite(F, P^, LongStrEntry.Len);
- FreeMem(P, Length(LongS)+1);
- end;
- for I := 0 to ListBox1.Items.Count-1 do begin
- if ListBox1.Items[I] <> '' then begin
- S := StringGrid1.Cells[2,I+1];
- with LangEntry do begin
- E := Pos('.', ListBox1.Items[I]);
- if E > 0 then begin
- ID := StrToInt(Copy(ListBox1.Items[I], 1, E-1));
- SubID := StrToInt(Copy(ListBox1.Items[I], E+1, Length(ListBox1.Items[I])-E+1));
- end else begin
- ID := StrToInt(ListBox1.Items[I]);
- SubID := 0;
- end;
- Len := Length(S);
- end;
- BlockWrite(F, LangEntry, SizeOf(LangEntry));
- BlockWrite(F, S[1], LangEntry.Len);
- end;
- end;
- CloseFile(F);
- Changed := False;
- Result := True;
- end;
-
- procedure TMainForm.LoadFile;
- var
- I, E: Integer;
- LangEntry: TLangEntry;
- LangFileHeader: TLangFileHeader;
- LongStrEntry: TLongStrEntry;
- P: PChar;
- F: File;
- LongS: String;
- S: String[255];
- begin
- if Confirmation = False then Exit;
- try
- try
- if OpenDialog1.Execute then begin
- Screen.Cursor := crHourGlass;
- Filename := OpenDialog1.FileName;
- AssignFile(F, Filename);
- Reset(F, 1);
- //BlockRead(F, S, SizeOf(sLangCopyrightStr));
- BlockRead(F, LangFileHeader, SizeOf(LangFileHeader));
- if LangFileHeader.IDStr <> sLangCopyrightStr then
- raise Exception.Create('Invalid Language File.');
- if LangFileHeader.Version <> 1 then
- raise Exception.Create('Invalid version of Language File.');
- Edit2.Text := LangFileHeader.Author;
- Edit3.Text := LangFileHeader.Comment;
- Edit4.Text := LangFileHeader.NatName;
- Edit5.Text := LangFileHeader.EngName;
- Label5.Caption := LangFileHeader.Created;
- for I := 1 to LangFileHeader.LongStrCount do begin
- BlockRead(F, LongStrEntry, SizeOf(TLongStrEntry));
- GetMem(P, LongStrEntry.Len+1);
- BlockRead(F, P^, LongStrEntry.Len);
- P[LongStrEntry.Len] := #0;
- LongS := P;
- FreeMem(P, LongStrEntry.Len+1);
- {if I = 1 then
- Memo2.Lines.Add(LongS);
- if I = 2 then
- Memo4.Lines.Add(LongS); }
- end;
- //
- while not Eof(F) do begin
- BlockRead(F, LangEntry, SizeOf(LangEntry));
- BlockRead(F, S[1], LangEntry.Len);
- SetLength(S, LangEntry.Len);
- if LangEntry.SubID <> 0 then
- E := ListBox1.Items.IndexOf(IntToStr(LangEntry.ID)+'.'+IntToStr(LangEntry.SubID))
- else
- E := ListBox1.Items.IndexOf(IntToStr(LangEntry.ID));
- StringGrid1.Cells[2,E+1] := S;
- end;
- end;
- finally
- Screen.Cursor := crDefault;
- Changed := False;
- try
- CloseFile(F);
- except end;
- end;
- except
- on Exception do MessageDlg('Invalid Language File.', mtError, [mbOK], 0);
- end;
- end;
-
- procedure TMainForm.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);
- begin
- //if ACol in [0,1] then CanSelect := False else CanSelect := True;
- end;
-
- procedure TMainForm.SpeedButton1Click(Sender: TObject);
- begin
- if NewFile = False then Exit;
- LoadFile;
- end;
-
- procedure TMainForm.SpeedButton2Click(Sender: TObject);
- begin
- SaveFile;
- end;
-
- procedure TMainForm.SpeedButton3Click(Sender: TObject);
- begin
- NewFile;
- end;
-
- procedure TMainForm.StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer; const Value: String);
- begin
- Changed := True;
- end;
-
- procedure TMainForm.SpeedButton4Click(Sender: TObject);
- begin
- SaveFileAs;
- end;
-
- procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
- begin
- if Confirmation = False then CanClose := False else CanClose := True;
- end;
-
- procedure TMainForm.SpeedButton6Click(Sender: TObject);
- begin
- Close;
- end;
-
- procedure TMainForm.SpeedButton7Click(Sender: TObject);
- begin
- if FileExists(sReadmeFile) then
- ShellExecute(Handle, 'open', PChar(sReadmeFile), '', PChar(ExtractFilePath(sReadmeFile)), SW_SHOWNORMAL);
- end;
-
- procedure TMainForm.Search1Click(Sender: TObject);
- begin
- PageControl1.ActivePage := TabSheet1;
- SearchIndex := 1;
- FindDialog1.Execute;
- end;
-
- procedure TMainForm.FindDialog1Find(Sender: TObject);
- var
- I: Integer;
- S: String;
- begin
- if SearchIndex > StringGrid1.RowCount-1 then Exit;
- for I := SearchIndex to StringGrid1.RowCount-1 do begin
- Inc(SearchIndex);
- S := LowerCase(StringGrid1.Cells[0,I]+' '+StringGrid1.Cells[1,I]+' '+StringGrid1.Cells[2,I]);
- if Pos(LowerCase(FindDialog1.FindText), S) <> 0 then begin
- StringGrid1.Row := I;
- StringGrid1.SetFocus;
- SetActiveWindow(StringGrid1.Handle);
- SearchIndex := I+1;
- Exit;
- end;
- end;
- MessageDlg('Search string '''+FindDialog1.FindText+''' not found!', mtInformation, [mbOK], 0);
- end;
-
- end.
-