home *** CD-ROM | disk | FTP | other *** search
/ Freelog 11 / Freelog011.iso / BestOf / PhoenixMail / Source / phoenix / LangSup.pas < prev    next >
Pascal/Delphi Source File  |  1999-01-11  |  14KB  |  413 lines
  1. {*****************************************************************************
  2.  *
  3.  *  LangSup.pas - Multi Language Support (23-September-1998)
  4.  *
  5.  *  Copyright (c) 1998-99 Michael Haller
  6.  *
  7.  *  Author:     Michael Haller
  8.  *  E-mail:     michael@discountdrive.com
  9.  *  Homepage:   http://www.discountdrive.com/sunrise
  10.  *
  11.  *  This program is free software; you can redistribute it and/or
  12.  *  modify it under the terms of the GNU General Public License
  13.  *  as published by the Free Software Foundation;
  14.  *
  15.  *  This program is distributed in the hope that it will be useful,
  16.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18.  *  GNU General Public License for more details.
  19.  *
  20.  *  You should have received a copy of the GNU General Public License
  21.  *  along with this program; if not, write to the Free Software
  22.  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
  23.  *
  24.  *----------------------------------------------------------------------------
  25.  *
  26.  *  Revision history:
  27.  *
  28.  *     DATE     REV                 DESCRIPTION
  29.  *  ----------- --- ----------------------------------------------------------
  30.  *
  31.  *****************************************************************************}
  32.  
  33. unit LangSup;
  34.  
  35. interface
  36.  
  37. uses
  38.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  39.   StdCtrls, ExtCtrls, Menus, Buttons, PXStuff, ComCtrls, ExtListView,
  40.   ComboBoxEx;
  41.  
  42. var
  43.   LangSupTagList: TStringList;
  44.  
  45. procedure LoadLanguageFile(Filename: String);
  46. procedure ClearUpLangFile;
  47. procedure AttachLanguageToForm(Form: TForm);
  48. procedure AttachLanguageToMemo(Index: Byte; var Memo: TMemo);
  49.  
  50. procedure SaveFormStrings(Form: TForm);
  51. procedure SaveMemo(Memo: TMemo);
  52.  
  53. implementation
  54.  
  55. uses
  56.   Main;
  57.  
  58. type
  59.   TLangFileHeader = record
  60.     IDStr: String[30];
  61.     Version: Byte;
  62.     Author: String[40];
  63.     Comment: String[50];
  64.     Created: String[10];
  65.     NatName: String[20];
  66.     EngName: String[20];
  67.     LongStrCount: Byte;
  68.   end;
  69.  
  70.   TLongStrEntry = record
  71.     Len: SmallInt;
  72.   end;
  73.  
  74.   TLangEntry = record
  75.     ID: SmallInt;
  76.     SubID: Byte;
  77.     Len: Byte;
  78.   end;
  79.  
  80. const
  81.   sLangCopyrightStr: String[30] = 'Phoenix Mail Language File';
  82.  
  83. var
  84.   T: Text;
  85.   SL: TStringList;
  86.   IDL: TStringList;
  87.   LanguageMemoString1, LanguageMemoString2: String;
  88.  
  89. procedure LoadLanguageFile(Filename: String);
  90. var
  91.   LangEntry: TLangEntry;
  92.   LangFileHeader: TLangFileHeader;
  93.   LongStrEntry: TLongStrEntry;
  94.   P: PChar;
  95.   F: File;
  96.   S: String[255];
  97.   LongS: String;
  98.   I: Integer;
  99. begin
  100.   LanguageMemoString1 := '';
  101.   LanguageMemoString2 := '';
  102.   AssignFile(F, Filename);
  103.   Reset(F, 1);
  104.   SL := TStringList.Create;
  105.   IDL := TStringList.Create;
  106.   //BlockRead(F, S, SizeOf(sLangCopyrightStr));
  107.   BlockRead(F, LangFileHeader, SizeOf(LangFileHeader));
  108.   if LangFileHeader.IDStr <> sLangCopyrightStr then
  109.     raise Exception.Create('Invalid Language File.');
  110.   if LangFileHeader.Version <> 1 then
  111.     raise Exception.Create('Invalid version of Language File.');
  112.   for I := 1 to LangFileHeader.LongStrCount do begin
  113.     BlockRead(F, LongStrEntry, SizeOf(TLongStrEntry));
  114.     GetMem(P, LongStrEntry.Len+1);
  115.     BlockRead(F, P^, LongStrEntry.Len);
  116.     P[LongStrEntry.Len] := #0;
  117.     LongS := P;
  118.     FreeMem(P, LongStrEntry.Len+1);
  119.     if I = 1 then LanguageMemoString1 := LongS;
  120.     if I = 2 then LanguageMemoString2 := LongS;
  121.   end;
  122.   //
  123.   while not EoF(F) do begin
  124.     BlockRead(F, LangEntry, SizeOf(LangEntry));
  125.     BlockRead(F, S[1], LangEntry.Len);
  126.     SetLength(S, LangEntry.Len);
  127.     SL.Add(S);
  128.     if LangEntry.SubID = 0 then
  129.       IDL.Add(IntToStr(LangEntry.ID))
  130.     else
  131.       IDL.Add(IntToStr(LangEntry.ID)+'.'+IntToStr(LangEntry.SubID));
  132.   end;
  133.   CloseFile(F);
  134. end;
  135.  
  136. procedure ClearUpLangFile;
  137. begin
  138.   SL.Free;
  139.   IDL.Free;
  140. end;
  141.  
  142. procedure AttachLanguageToForm(Form: TForm);
  143. var
  144.   CL: TList;
  145.   I, E, G, K: Integer;
  146.   C: TComponent;
  147.  
  148.  procedure LCRecursive(Component: TComponent);
  149.   var
  150.     I: Integer;
  151.   begin
  152.     for I := 0 to Component.ComponentCount-1 do begin
  153.       if Component.Components[I].Tag <> 0 then
  154.         CL.Add(Component.Components[I]);
  155.       if Component.Components[I].ComponentCount > 0 then
  156.         LCRecursive(Component.Components[I]);
  157.     end;
  158.   end;
  159.  
  160. begin
  161.   if bLanguageLoaded = False then Exit;
  162.   CL := TList.Create;
  163.   CL.Add(TComponent(Form));
  164.   LCRecursive(TComponent(Form));
  165.   for I := 0 to CL.Count-1 do begin
  166.     C := TComponent(CL.Items[I]);
  167.     G := IDL.IndexOf(IntToStr(C.Tag));
  168.     if C is TListBox then begin
  169.       for K := 0 to TListBox(CL.Items[I]).Items.Count-1 do begin
  170.         E := IDL.IndexOf(IntToStr(Abs(C.Tag))+'.'+IntToStr(K+1));
  171.         if (E >= 0) and (SL.Strings[E] <> '') then
  172.           TListBox(CL.Items[I]).Items[K] := SL.Strings[E];
  173.       end;
  174.     end else
  175.     if C is TComboBoxEx then begin
  176.       for K := 0 to TComboBoxEx(CL.Items[I]).Items.Count-1 do begin
  177.         E := IDL.IndexOf(IntToStr(Abs(C.Tag))+'.'+IntToStr(K+1));
  178.         if (E >= 0) and (SL.Strings[E] <> '') then
  179.           TComboBoxEx(CL.Items[I]).Items[K] := SL.Strings[E];
  180.       end;
  181.     end else
  182.     if C is TOpenDialog then begin
  183.       E := IDL.IndexOf(IntToStr(Abs(C.Tag))+'.'+IntToStr(1));
  184.       if (E >= 0) and (SL.Strings[E] <> '') then
  185.         TOpenDialog(CL.Items[I]).Title := SL.Strings[E];
  186.       E := IDL.IndexOf(IntToStr(Abs(C.Tag))+'.'+IntToStr(2));
  187.       if (E >= 0) and (SL.Strings[E] <> '') then
  188.         TOpenDialog(CL.Items[I]).Filter := SL.Strings[E];
  189.     end else
  190.     if C is TListView then begin
  191.       for K := 0 to TListView(CL.Items[I]).Columns.Count-1 do begin
  192.         E := IDL.IndexOf(IntToStr(Abs(C.Tag))+'.'+IntToStr(K+1));
  193.         if (E >= 0) and (SL.Strings[E] <> '') then
  194.           TListView(CL.Items[I]).Columns[K].Caption := SL.Strings[E];
  195.       end;
  196.     end else
  197.     if C is TExtListView then begin
  198.       for K := 1 to TExtListView(CL.Items[I]).Columns.Count-1 do begin
  199.         E := IDL.IndexOf(IntToStr(Abs(C.Tag))+'.'+IntToStr(K+1));
  200.         if (E >= 0) and (SL.Strings[E] <> '') then
  201.           TExtListView(CL.Items[I]).Columns[K].Caption := SL.Strings[E];
  202.       end;
  203.     end else begin
  204.       E := IDL.IndexOf(IntToStr(Abs(C.Tag)));
  205.       if (E >= 0) and (SL.Strings[E] <> '') then begin
  206.         if C is TLabel then TLabel(CL.Items[I]).Caption := SL.Strings[E] else
  207.         if C is TMenuItem then TMenuItem(CL.Items[I]).Caption := SL.Strings[E] else
  208.         if C is TRadioButton then TRadioButton(CL.Items[I]).Caption := SL.Strings[E] else
  209.         if C is TButton then TButton(CL.Items[I]).Caption := SL.Strings[E] else
  210.         if C is TSpeedButton then TSpeedButton(CL.Items[I]).Caption := SL.Strings[E] else
  211.         if C is TTabSheet then TTabSheet(CL.Items[I]).Caption := SL.Strings[E] else
  212.         if C is TCheckBox then TCheckBox(CL.Items[I]).Caption := SL.Strings[E] else
  213.         if C is TForm then TForm(CL.Items[I]).Caption := SL.Strings[E];
  214.       end;
  215.     end;
  216.     if (G >= 0) and (C.Tag < 0) and (SL.Strings[G] <> '') then begin
  217.       if C is TControl then TControl(CL.Items[I]).Hint := SL.Strings[G];
  218.     end;
  219.   end;
  220.   CL.Free;
  221. end;
  222.  
  223. procedure AttachLanguageToMemo(Index: Byte; var Memo: TMemo);
  224. var
  225.   E: Integer;
  226.   S: String;
  227. begin
  228.   if Index = 1 then begin
  229.     S := LanguageMemoString1;
  230.     if S = '' then Exit;
  231.   end;
  232.   if Index = 2 then begin
  233.     S := LanguageMemoString2;
  234.     if S = '' then Exit;
  235.   end;
  236.   Memo.Lines.Clear;
  237.   E := Pos('º', S);
  238.   while E > 0 do begin
  239.     S[E] := #10;
  240.     Insert(#13, S, E);
  241.     E := Pos('º', S);
  242.   end;
  243.   Memo.Lines.Add(S);
  244. end;
  245.  
  246. procedure SaveMemo(Memo: TMemo);
  247. var
  248.   I: Integer;
  249. begin
  250.   AssignFile(T, sTempLanguageFile);
  251.   if FileExists(sTempLanguageFile) then
  252.     Append(T)
  253.   else
  254.     Rewrite(T);
  255.   WriteLn(T, IntToStr(Memo.Lines.Count-1));
  256.   for I := 1 to Memo.Lines.Count-1 do
  257.     WriteLn(T, Memo.Lines[I]);
  258.   CloseFile(T);
  259. end;
  260.  
  261. procedure SaveFormStrings(Form: TForm);
  262. var
  263.   CL: TList;
  264.   I, K: Integer;
  265.   HasCaption: Boolean;
  266.   S: String;
  267.  
  268.   procedure LCRecursive(Component: TComponent);
  269.   var
  270.     I: Integer;
  271.   begin
  272.     for I := 0 to Component.ComponentCount-1 do begin
  273.       CL.Add(Component.Components[I]);
  274.       if Component.Components[I].ComponentCount > 0 then
  275.         LCRecursive(Component.Components[I]);
  276.     end;
  277.   end;
  278.  
  279. begin
  280.   CL := TList.Create;
  281.   CL.Add(TComponent(Form));
  282.   LCRecursive(TComponent(Form));
  283.   AssignFile(T, sTempLanguageFile);
  284.   if FileExists(sTempLanguageFile) then
  285.     Append(T)
  286.   else
  287.     Rewrite(T);
  288.   for I := 0 to CL.Count-1 do begin
  289.     if TComponent(CL.Items[I]).Tag <> 0 then begin
  290.       if LangSupTagList.IndexOf(IntToStr(TComponent(CL.Items[I]).Tag)) = -1 then begin
  291.  
  292.       LangSupTagList.Add(IntToStr(TComponent(CL.Items[I]).Tag));
  293.       HasCaption := False;
  294.       if TComponent(CL.Items[I]) is TMenuItem then begin
  295.         if TMenuItem(CL.Items[I]).Caption <> '' then begin
  296.           WriteLn(T, TMenuItem(CL.Items[I]).Caption);
  297.           HasCaption := True;
  298.         end;
  299.       end else
  300.       if TComponent(CL.Items[I]) is TSpeedButton then begin
  301.         if TSpeedButton(CL.Items[I]).Caption <> '' then begin
  302.           WriteLn(T, TSpeedButton(CL.Items[I]).Caption);
  303.           HasCaption := True;
  304.         end;
  305.       end else
  306.       if TComponent(CL.Items[I]) is TLabel then begin
  307.         if TLabel(CL.Items[I]).Caption <> '' then begin
  308.           WriteLn(T, TLabel(CL.Items[I]).Caption);
  309.           HasCaption := True;
  310.         end;
  311.       end else
  312.       if TComponent(CL.Items[I]) is TForm then begin
  313.         if TForm(CL.Items[I]).Caption <> '' then begin
  314.           WriteLn(T, TForm(CL.Items[I]).Caption);
  315.           HasCaption := True;
  316.         end;
  317.       end else
  318.       if TComponent(CL.Items[I]) is TCheckBox then begin
  319.         if TCheckBox(CL.Items[I]).Caption <> '' then begin
  320.           WriteLn(T, TCheckBox(CL.Items[I]).Caption);
  321.           HasCaption := True;
  322.         end;
  323.       end else
  324.       if TComponent(CL.Items[I]) is TRadioButton then begin
  325.         if TRadioButton(CL.Items[I]).Caption <> '' then begin
  326.           WriteLn(T, TRadioButton(CL.Items[I]).Caption);
  327.           HasCaption := True;
  328.         end;
  329.       end else
  330.       if TComponent(CL.Items[I]) is TTabSheet then begin
  331.         if TTabSheet(CL.Items[I]).Caption <> '' then begin
  332.           WriteLn(T, TTabSheet(CL.Items[I]).Caption);
  333.           HasCaption := True;
  334.         end;
  335.       end else
  336.       if TComponent(CL.Items[I]) is TButton then begin
  337.         if TButton(CL.Items[I]).Caption <> '' then begin
  338.           WriteLn(T, TButton(CL.Items[I]).Caption);
  339.           HasCaption := True;
  340.         end;
  341.       end;
  342.  
  343.       if HasCaption then begin
  344.         WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag)));
  345.         S := TComponent(CL.Items[I]).ClassName;
  346.         WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+' Caption '+Copy(S, 2, Length(S)-1));
  347.       end;
  348.  
  349.       if TComponent(CL.Items[I]) is TListBox then begin
  350.         S := TComponent(CL.Items[I]).ClassName;
  351.         S := Copy(S, 2, Length(S)-1);
  352.         for K := 0 to TListBox(CL.Items[I]).Items.Count-1 do begin
  353.           WriteLn(T, TListBox(CL.Items[I]).Items[K]);
  354.           WriteLn(T, IntToStr(TComponent(CL.Items[I]).Tag)+'.'+IntToStr(K+1));
  355.           WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+'.'+IntToStr(K+1)+' Item '+S);
  356.         end;
  357.       end;
  358.       if TComponent(CL.Items[I]) is TComboBoxEx then begin
  359.         S := TComponent(CL.Items[I]).ClassName;
  360.         S := Copy(S, 2, Length(S)-1);
  361.         for K := 0 to TComboBox(CL.Items[I]).Items.Count-1 do begin
  362.           WriteLn(T, TComboBox(CL.Items[I]).Items[K]);
  363.           WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+'.'+IntToStr(K+1));
  364.           WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+'.'+IntToStr(K+1)+' Item '+S);
  365.         end;
  366.       end;
  367.       if TComponent(CL.Items[I]) is TOpenDialog then begin
  368.         S := TComponent(CL.Items[I]).ClassName;
  369.         S := Copy(S, 2, Length(S)-1);
  370.         WriteLn(T, TOpenDialog(CL.Items[I]).Title);
  371.         WriteLn(T, IntToStr(TComponent(CL.Items[I]).Tag)+'.'+IntToStr(1));
  372.         WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+'.'+IntToStr(1)+' Title '+S);
  373.         WriteLn(T, TOpenDialog(CL.Items[I]).Filter);
  374.         WriteLn(T, IntToStr(TComponent(CL.Items[I]).Tag)+'.'+IntToStr(2));
  375.         WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+'.'+IntToStr(2)+' Filter '+S);
  376.       end;
  377.       if TComponent(CL.Items[I]) is TListView then begin
  378.         S := TComponent(CL.Items[I]).ClassName;
  379.         S := Copy(S, 2, Length(S)-1);
  380.         for K := 0 to TListView(CL.Items[I]).Columns.Count-1 do begin
  381.           WriteLn(T, TListView(CL.Items[I]).Columns[K].Caption);
  382.           WriteLn(T, IntToStr(TComponent(CL.Items[I]).Tag)+'.'+IntToStr(K+1));
  383.           WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+'.'+IntToStr(K+1)+' Column '+S);
  384.         end;
  385.       end;
  386.       if TComponent(CL.Items[I]) is TExtListView then begin
  387.         S := TComponent(CL.Items[I]).ClassName;
  388.         S := Copy(S, 2, Length(S)-1);
  389.         for K := 1 to TExtListView(CL.Items[I]).Columns.Count-1 do begin
  390.           WriteLn(T, TExtListView(CL.Items[I]).Columns[K].Caption);
  391.           WriteLn(T, IntToStr(TComponent(CL.Items[I]).Tag)+'.'+IntToStr(K+1));
  392.           WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+'.'+IntToStr(K+1)+' Column '+S);
  393.         end;
  394.       end;
  395.  
  396.       if TComponent(CL.Items[I]).Tag < 0 then
  397.         if TComponent(CL.Items[I]) is TControl then begin
  398.           if TControl(CL.Items[I]).Hint <> '' then begin
  399.             WriteLn(T, TControl(CL.Items[I]).Hint);
  400.             WriteLn(T, IntToStr(TComponent(CL.Items[I]).Tag));
  401.             S := TComponent(CL.Items[I]).ClassName;
  402.             WriteLn(T, IntToStr(Abs(TComponent(CL.Items[I]).Tag))+' Hint '+Copy(S, 2, Length(S)-1));
  403.           end;
  404.         end;
  405.       end;
  406.     end;
  407.   end;
  408.   CL.Free;
  409.   CloseFile(T);
  410. end;
  411.  
  412. end.
  413.