Obsługa wielu języków

Od dłuższego czasu poszukiwałem rozwiązania które pozwalałoby na tworzenie tłumaczeń programów (oraz obsługi tych tłumaczeń) w łatwy sposób... Łatwy- czyli z pominięciem setek lini kodu odpowiedzialnych za ładowanie kolejnych napisów. Czyli pliki ini i ładowanie z nich na zasadzie

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

odpadają ;)
Oczywiście następnym krokiem ewolucji byłoby szukanie komponentów po nazwach... ale tu pozostaje problem rzutowania typu, aby móc przypisać coś do caption musimy napisać

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

a przecież nie o to mi chodzi... Dlatego też kombinowałem dalej (jak by se tu życie uprościć) ... i wykombinowałem.
Udało mi się stworzyć system wczytywania który umożliwia na przypisanie praktycznie każdej właściwości do każdego typu komponentu (czyli w przypadku komponentu, który zamiast Caption ma np. MyCaption nie sprawia problemu :) )
Format plików z językami to:
Form1|Button1|Caption=To działa!|Hint=Hint też działa|ShowHint=true
Ze względu na czasochłonne i męczące pisanie "ręczne" plików z językiem, oraz jeszcze gorsze i nieużyteczne (w przypadku dodawania nowych komponentów) rozwiązanie z generowanie plików języka przez odpowiednią procedurę, zdecydowałem się na napisanie plugina do delphi. Zaznaczamy wybrane komponenty, klikamy PMM i w schowku powinien pojawić się kod. Więcej w readme dołączonego pliku (binarka + source + readme):
http://4programmers.net/File:multilang_generator.rar.

Teraz po kolei omówię pola (oddzielone znakiem | )
Pierwsze dwa to pola obowiązkowe!
Pole numer jeden, przechowuje nazwę formy - parenta
Pole numer dwa przechowuje nazwę obiektu który będziemy teraz męczyć ;)
Pozostałe pola są w formacie NazwaWłaściwości=Wartośc
Pól tych może być dowolna ilość

Dopisano: co do form tworzonych po starcie aplikacji, czyli np.

var
  TF : TForm2;
begin
  TF := TForm2.Create(Application);

nalezy pamiętać aby tworzyć je jako childy aplikacji, inaczej tłumaczenie nie obejmie tej formy!

Za przejście do następnego obiektu uważa się koniec lini.

Ważne: wszelkie spacje nie są usuwane, dlatego zapis Form1 | Button1 | Caption =Costam| Hint=nic jest nieprawidłowy!!

W pliku języka można też przechowywać informacje o nazwie języka, jego twórcy, stronie internetowej twórcy i jego adresie e-mail.
przykład umieszczenia informacji w pliku:

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

wszystkie inne linie zaczynające się znakiem komentarza ( '#' ) są ignorowane.

Poniżej przedstawię listing pliku MultiLanguage.pas oraz omówię jego funkcje (reszta jest [lub nie ;)] w komentarzach).

(*--------------------------------------------|
| MultiLanguage System Unit                   |
|---------------------------------------------|
| author: Michał Gajek                        |
| web: http://www.migajek.com                 |
| email: migajek[...]yahoo[...]com            |
| Copyright ?  2005 by Michał Gajek           |
| Update and corrections: woolfik@gmail.com   |
|---------------------------------------------|
| 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[II] <> '') and (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 F <> 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;  // <=====  WTF is that? o.O   ['mój dopisek']
                Exit;   // <===== najpierw break a potem Exit? exit sie nie wywoła.
              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(['.'], [], Ochar(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.

Obiecałem omówienie funkcji - to obietnicy dotrzymam :)
LoadLangFromFile - ładuje język z pliku podanego w pierwszym parametrze.
SetLang - po załadowaniu języka wprowadza go w życie ;) Jesli parametr jest pusty - funkcja ustawia dane na wszystkich formach... jesli nie jest pusty to ustawia tylko na formie o podanej nazwie... przydatne w przypadku dynamicznie tworzonych form. Oszczednosc czasu w działaniu aplikacji:)

GetFileInfo - po podaniu w parametrze nazwy pliku zwraca rekord z informacjami o nim, czyli nazwa języka i dane o jego autorze.
GenerateLanguageFile - w parametrze podaje się forme dla której chcemy stworzyć plik języka (dzięki temu można zaoszczędzić czas i mieć pewność że żaden komponent nam nie umknie :) ). Funkcja bardzo niedoskonała, narazie generuje tylko parametry Caption, Hint i Text

No cóż to chyba wszystko, proszę o uwagi i oceny (niezbyt surowe :P )
Sądzę że nad plikiem będe jeszcze pracował - poprawki opublikuję tutaj :)

W załączniku dodaję demo :)

wersja 1.2 : dodano obsluge childow w komponentow, tzn mozna teraz uzyskac dostep do np. LabeledEdit1.SubLabel.Caption. Przykładem zmiany podpisu LabeledEdit jest

wersja 1.3 : poprawiono obsługę subklas, teraz mozżna uzyskac dostęp do przykładowo JvWizardWelcomePage1.Subtitle.Text w następujący sposób:

Form1|JvWizardWelcomePage1|Subtitle.Text=aaa

Form1|LabeledEdit1.SubLabel|Caption=costam

multilang_generator.rar

Niestety autor sie nie odzywał więc postanowiłem dokonać kilku modyfikacji:
wersja 1.4: dodano obsługę MidiChild, TDataModul oraz Items np w Combobox lub Radiogroup
Form1|GadioGroup1|Caption=Pobieraj logi:|Items=Wszystkie,"Tylko nowsze"

Wersja 1.5
Dodana obsługa subobiektow np dbgrid i listview

Wersja 1.6
Czekam na sugestie :)

PS.
Ostatnio spotkałem się z błędem przy obsłudze TListView dlatego warto zwrócić uwagę na ten komponent. Postaram się dodać poprawkę najszybciej jak to będzie mozliwe