Obsługa wielu języków

Button1.Caption := INI.ReadString('Form1','Button1','')

TButton(Form1.FindComponent(NazwaKomponentu)).Caption := ... 

Form1|Button1|Caption=To działa!|Hint=Hint też działa|ShowHint=true

var TF:TForm2;
begin
TF:=TForm2.Create(<b>Application</b>);

Form1 | Button1 | Caption =Costam| Hint=nic

#Author=Michał Gajek
#Language=Polski
#Website=http://www.migajek.com
#Email=migajek [zgadnij] yahoo.com

(*--------------------------------------------|
| MultiLanguage System Unit                   |
|---------------------------------------------|
| author: Michał Gajek                        |
| web: http://www.migajek.com                 |
| email: migajek[...]yahoo[...]com                    |
| Copyright ?  2005 by Michał Gajek           |
|---------------------------------------------|
| Released under the terms and conditions of  |
| the GNU General Public License (Version 2)  |
+--------------------------------------------*)

{
Version 1.5
 Dodana obsluga form dynamicznych
 Dodana obsluge subobiektow (childow) w komponentach
 Poprawiona obsluge klas subobiektow
}


unit MultiLanguage;

interface

uses Windows, Classes, TypInfo, Forms, SysUtils, Dialogs, IniFiles, Controls, DBGrids;

type
  TLanguageFileInfo = record //informacje o pliku jezyka
   Lang : string ; //nazwa jezyka
   Author,www,email:string; //dane o autorze
  end;

  TProperty = record //wlasciwosc obiektu
   PropName:string; //nazwa wlasciwosci, np caption lub hint
   PropValue: string; //wartosc wlasciwosci
  end;

  TLangObject = record // jeden obiekt  do przetlumaczenia
   FormName:string; //nazwa formy-parenta
   ObjName: string; //nazwa obiektu
   Properties : array of TProperty; //parametry
  end;

  TLanguage = record //jezyk, z pliku
   FileInfo:TLanguageFileInfo; //informacje o pliku
   FileName: string; // nazwa pliku
   LangObjects: array of TLangObject; //obiekty do zmiany
  end;


const
 CommentChr:char='#';
 BreakLineSign:string[2]='\n';
 ClassSep:char='.';
var
  MainLang:TLanguage;
  plikINI: TMemIniFile;

procedure LoadLangFromFile(FileName:string); //laduje jezyk do pamieci
procedure SetLang(OnlyFormName:string=''); //ustawia (stosuje) zmiany z pliku jezyka

function Translate(sekcja, text: string): string;

function GetFileInfo(FName:string):TLanguageFileInfo; //zwraca informacje o pliku

function GenerateLanguageFile(Form:TForm):TStringList; //generuje plik jezyka, dzieki temu nie zapomniy o zadnym komponencie

implementation

{==============               FUNKCJE WEWNETRZNE         ===================}

function GetPropValue(s:string;separator:string='='): string; //pobiera wartosc wlasciwosci
begin
  result := StringReplace(copy(s,pos(separator,s)+1,length(s)),BreakLineSign,#10,[rfReplaceAll]); //zamien przy okazji znak \n na #10
end;

function GetPropName(s:string;separator:string='='): string; //pobiera nazwe wlasciwosci
begin
  result := copy(s,1,pos(separator,s)-1);
end;

function GetCommentValue(TS:TStringList;Prop:string):string; //pobiera dane z komentarza, np. #author=jan kowalski
var
  i:integer;
begin
  result:='';
  if ts=nil then exit;

  for i:=0 to ts.Count-1 do
  begin
    if pos(CommentChr+Prop,ts[i])>0 then //jesli w tej lini jest #nazwa_wlasciwosci
    begin
      result:=GetPropValue(Copy(ts[i],pos(CommentChr,ts[i]),length(ts[i])));//zwroc sama wartosc
      exit;
    end;
  end;
end;
{============== KONIEC FUNKCJI WEWNETRZNYCH ================}

{======= funkcja laduje plik do pamieci rozdzielajac dane do zmiennych===========}

procedure LoadLangFromFile(FileName:string);
var
  ts,line:tstringList; //ts: plik ; line:lista po explode
  i,j:integer; //zmienne do petli
begin
  plikINI := TMemIniFile.Create(FileName);
  if not FileExists(FileName ) then exit; //jak nie ma pliku to won

  ZeroMemory(@MainLang,SizeOf(MainLang)); //wyczyść ;)

  MainLang.FileName:=FileName; //ustaw nazwe pliku w rekordzie - czasem przydatne

  ts:=Tstringlist.Create;  //zawartosc pliku
  line:=tstringList.Create; /// rozbita linia
  ts.LoadFromFile(filename); //ladowanie

  MainLang.FileInfo := GetFileInfo(FileName); //pobierz informacje o pliku

  for i:=ts.Count-1 downto 0 do //usuwanie komentarzy
   begin
    if ts.Strings[i] <>'' then
     if ts.Strings[i][1] = CommentChr then
      ts.Delete(i);
   end;

  for i:=0 to ts.Count-1 do
  begin
   line.Clear;
   ExtractStrings(['|'],[],pchar(ts[i]),line); //rozbij linię znakami |
    if not(line.Count<2) then //jesli nie jest mniej niz dwie linie po rozbiciu (znaczy jest nazwa formy i obiektu)
     begin
      SetLength(MainLang.LangObjects,length(mainLang.LangObjects)+1); //zwieksz pojemnosc tablicy z elementami (obiektami)
      with MainLang.LangObjects[high(MainLang.langobjects)] do //operacje na najnowszym obiekcie
       begin
        FormName:=   line[0]; //ustaw nazwe formy dla obiektu
        ObjName :=   line[1]; //ustaw nazwe obiektu
        for j:=2 to line.Count-1 do //teraz wykonuj operacje na pozostalych wlasciwosciach (nie wiemy ile ich bedzie)
         begin

          SetLength(Properties,length(properties)+1); //ustaw dlugosc tablicy z wlasciwosciami
          Properties[high(properties)].PropName:=GetPropName(line[j]); //wczytaj nazwe wlasciwosci, np. Caption  (czyli to ci przed znakiem '=' )
          Properties[high(properties)].PropValue:=GetPropValue(line[j]); //wczytaj wartosc wlasciwosci, np. 'Przycisk 1' (czyli co po zanku '=' );
         end;
       end;

     end;

  end;

  line.Free; //zwolnij pamiec
  ts.Free; //zwolnij pamiec
end;


{============= ustawia jezyk (wprowadza zmiany na komponentach ==========}

procedure SetLang(OnlyFormName:string='');
var
  i,j, z:integer;
  o:TForm;
  d: TDataModule;
  c:TObject;

  function FindControl(ObjName:string):TObject; //znajduje kontrolke :)
  var
    i,j:integer;
    Ctree:TStringList;
    obj:TComponent;
  begin
    result:=nil;
    if o<>nil then
    begin
      Ctree:=TStringList.Create;
      ExtractStrings([ClassSep],[],PChar(ObjName),Ctree);
      if CTree.Count=-1 then exit;
        for i:=0 to o.ComponentCount-1 do
        begin
          if (o.Components[i].Name=Ctree[0]) then
          begin
           obj:=o.Components[i];
           for j:=1 to Ctree.Count-1 do
             obj:=obj.FindComponent(Ctree[j]); //szukaj koleujnych, oddzielonych kropka
           result:=obj;
           break;
           exit;
           end;
         end;
      CTree.free;
    end
    else
      if d <> nil then
      begin
        Ctree:=TStringList.Create;
        ExtractStrings([ClassSep],[],PChar(ObjName),Ctree);
        if CTree.Count=-1 then exit;
          for i:=0 to d.ComponentCount-1 do
          begin
            if (d.Components[i].Name=Ctree[0]) then
            begin
             obj:=d.Components[i];
             for j:=1 to Ctree.Count-1 do
               obj:=obj.FindComponent(Ctree[j]); //szukaj koleujnych, oddzielonych kropka
             result:=obj;
             break;
             exit;
             end;
           end;
        CTree.free;
      end
      else
        exit;
  end;

  procedure SetValue(obj:TObject;PName:string;PValue:string);
  var
    ts: TStringList;
    items: TStrings;
    i: Integer;
    col : TCollection ;
    o:TObject;
  begin
    ts:=TStringList.Create;
    ExtractStrings(['.'],[],pchar(pname),ts);

    o:=obj;
    for i:=0 to ts.Count-2 do
    begin
     if typinfo.IsPublishedProp(o,ts[i]) then
       o:=typinfo.GetObjectProp(o,ts[i]);
    end;
    if typinfo.IsPublishedProp(o,ts[ts.count-1]) then //jesli wlasciwosc istnieje
     if ts[ts.count-1] = 'Items' then
       begin
         //i := (o as TCustomListControl).ItemIndex ;
         items := typinfo.GetDynArrayProp(o,ts[ts.count-1]);
         items.DelimitedText := PValue ;
        // (o as TCustomListControl).ItemIndex := i ;
       end
     else if ts[ts.count-1] = 'Columns' then
        begin
          col := (typinfo.GetObjectProp(o,ts[ts.count-1]) as TCollection) ;
          items := TStringList.Create;
          try

            items.DelimitedText := PValue ;
            for i := 0 to items.Count - 1 do
              if col.Count >= i then
                if typinfo.IsPublishedProp(col.Items[i], 'Caption') then
                   typinfo.SetPropValue(col.Items[i], 'Caption', items[i]) // np Listview
                else
                 if typinfo.IsPublishedProp(col.Items[i] , 'Title') then
                   (typinfo.GetObjectProp(col.Items[i] , 'Title') as TColumnTitle).Caption := items[i] //np DBGrid
          finally
            items.Free;
          end;
        end
     else
       typinfo.SetPropValue(o,ts[ts.count-1],PValue); //ustaw wlasciwosc
    ts.Free;
  end;

begin
  for i:=Low(MainLang.LangObjects) to High(MainLang.LangObjects) do
  begin
    with MainLang.LangObjects[i] do
    begin
      if (OnlyFormName='') or (lowercase(OnlyFormName) = lowercase(FormName)) then
      begin //jesli nazwa obecna jest rowna nazwie oczekiwanej to idz dalej
        for z := 0 to Screen.FormCount - 1 do
          if Screen.Forms[z].Name = FormName then
            o := Screen.Forms[z];

        if o = nil then
        begin
          d:=(Application.FindComponent(FormName) as TDataModule);
          if d = nil then
            exit;
        end;

        if FindControl(ObjName) <> nil then
        begin
          c:=FindControl(ObjName);
          for j:=low(Properties) to high(Properties) do //pobieraj wlasciwosci
          begin
            SetValue(c,Properties[j].PropName,Properties[j].PropValue);
          end;
        end;
      end;
   end;
  end;
end;

{=============== POZOSTALE TLUMACZENIA =================}
function Translate(sekcja, text: string): string;
begin
  if plikINI <> nil then
    Result := plikINI.ReadString(sekcja, text, text);
end;
{=======================================================}

{================zwraca informacje o pliku =============}

function GetFileInfo(FName:string):TLanguageFileInfo; //zwraca informacje o pliku
var
  ts:TStringList;
begin
  if not fileexists(FName) then exit;

  ts:=TStringList.Create;
  ts.LoadFromFile(Fname);

  result.Lang:=GetCommentValue(ts,'Language');
  result.Author:=GetCommentValue(ts,'Author');
  result.Www:=GetCommentValue(ts,'Website');
  result.email:=GetCommentValue(ts,'Email');

  ts.Free;
end;


//generuje plik jezyka, dzieki temu nie zapomniy o zadnym komponencie
function GenerateLanguageFile(Form:TForm):TStringList;
var
  items : tstrings ;
  col : TCollection ;
  i,j,k,cnt:integer;
  PropList:PPropList; // lista wlasciwosci :: typinfo.dcu
  PropName:string; //tymczasowa zmienna z nazwa wartosci . UWAGA!!! Lowercase!!
  PropTxt:string;
  ts:string ;
begin
  result:=TStringList.Create;
  result.Clear;
  if Form=nil then exit;

  for i:=0 to Form.ComponentCount-1 do
  begin
    cnt:=GetPropList(Form.Components[i],PropList);// zwraca liczbe wlasciwosci, a do prolist: liste wlasciwosci
    PropTxt:='';
    for j:=0 to cnt-1 do
    begin
      PropName := lowercase(PropList[j].Name); //pobierz tymczasowa zmienna
      if (PropName = 'text')or(propname='caption')or(propName='hint') then
       if typinfo.GetPropValue(Form.Components[i],PropList[j].Name) <> '' then
        PropTxt:=PropTxt+'|'+PropList[j].Name+'='+typinfo.GetPropValue(Form.Components[i],PropList[j].Name);
      if (PropName='items') then
       if typinfo.GetDynArrayProp(Form.Components[i],PropList[j].Name) <> nil then
         begin
           items := typinfo.GetDynArrayProp(Form.Components[i],PropList[j].Name) ;
           try
            PropTxt:=PropTxt+'|'+PropList[j].Name+'='+items.DelimitedText ;
           except
           end;
         end;
      if (PropName='columns') then
       if typinfo.GetDynArrayProp(Form.Components[i],PropList[j].Name) <> nil then
         begin
           col := (typinfo.GetObjectProp(Form.Components[i],PropList[j].Name) as TCollection) ;
           if col.Count > 0 then
             begin
               ts := '"'+col.Items[0].DisplayName+'"' ;
               for k := 1 to col.Count-1 do
                 ts := ts+',"'+col.Items[k].DisplayName+'"'
             end ;
              PropTxt:=PropTxt+'|'+PropList[j].Name+'='+ts ;
           // PropTxt:=PropTxt+'|'+PropList[j].Name+'='+items.DelimitedText ;
         end;

     end;
  if proptxt<>'' then
   result.Text:=result.text+Form.Name+'|'+Form.Components[i].Name+proptxt;
 end;
end;

end.

Form1|JvWizardWelcomePage1|Subtitle.Text=aaa

Form1|LabeledEdit1.SubLabel|Caption=costam