Forum > Translations

FormTranslation using rtti : why not ?

(1/1)

hermanzu:
Hi all ! All I've read here about working with .po files here is not seems very good to me.   PO files contains all info to localize form definitions - so why I have to translate resourcestrings separately and then assign values  to form properties manually?   It possible to automate this... something looks like this  ( it is very dirty code - just only idea ):


1) call  LoadPoFile(....)  somewhere  before any form creation
2) call  LocalizeInstance ( self ) in .FormCreate()

So everybody welcome and goodluck  :)


--- Code: ---unit reflection;

{$mode objfpc}{$H+}

interface

procedure LoadPoFile( const s: ansiString );
procedure LocalizeInstance ( Instance :TObject );

implementation
uses
  Classes, SysUtils,typInfo;

type
    TInforec = record
         MPropInfo :PPropInfo;
         case TTypeKind of
         tkUnknown:();
         tkInteger:(irInteger:longint);
         tkChar:(irChar:Char);
         tkFloat:(irFloat:Extended);
         tkString:(irString:string[255]);
         tkClass:(irObject:TObject);
         tkWChar:(irWChar:WideChar);
    end;

type

{ TPOItem }

TPOItem = class
  constructor Create ( _rttiInfo: ansiString;  _msgctxt : ansiString; _msgid   : ansiString; _msgstr  : ansiString );
public
  rttiInfo: ansiString;
  msgctxt : ansiString;
  msgid   : ansiString;
  msgstr  : ansiString;
end;

{ TPOItem }

constructor TPOItem.Create(_rttiInfo: ansiString; _msgctxt: ansiString; _msgid: ansiString;
  _msgstr: ansiString);
begin
   inherited Create;
   rttiInfo:= _rttiInfo;
   msgctxt := _msgctxt;
   msgid   := _msgid;
   msgstr  := _msgstr;
end;

type

{ TPOCache }

TPOCache  = class( TList )
  constructor Create;
  destructor Destroy; override;
  procedure Cleanup;
  procedure ParseFile( const fileName : ansiString );
  function FindItem( const tclassName : ansiString; from : integer ) : integer;
end;

{ TPOCache }

constructor TPOCache.Create;
begin
   inherited Create;
end;

destructor TPOCache.Destroy;
begin
   Cleanup;
   inherited Destroy;
end;

procedure TPOCache.Cleanup;
var i : Integer;
begin
   for i := 0 to Count - 1  do begin
      if( Assigned( self[i] ) ) then begin
          TObject(self[i]).destroy;
          self[i]:= nil;
      end;
   end;
   Clear;
end;

procedure TPOCache.ParseFile(const fileName: ansiString);
var lst : TStringList;
var i   : Integer;
var s   : ansiString;

var _rttiInfo : ansiString;
var _msgctxt  : ansiString;
var _msgid    : ansiString;
var _msgstr   : ansiString;

  function extractValue( const s: ansiString; from : Integer ) : ansiString;
  begin
     result := trim( copy(s, from, Length(s) ) );
     if result[1] ='"' then result := copy( result, 2, length( result ) );
     if result[length( result ) ] ='"' then result := copy( result, 1, length( result ) -1 );
  end;

begin
   lst := TStringList.Create;
   _rttiInfo := '';
   _msgctxt  := '';
   _msgid    := '';
   _msgstr   := '';
   try
     lst.LoadFromFile( fileName );
     i := 0;
     while ( i <  lst.Count ) do begin

        //skip empty lines
        while( ( i < lst.Count )  and ( trim( lst[i] ) = '' ) )  do inc( i );
        if( i >=  lst.Count ) then break;

        s := trim( lst[i] );
        if( s = '' ) then
           beep (* strange - never pass it *)
        else if( copy( s, 1, 2 ) = '#:' )  then begin
          _rttiInfo :=  extractValue( s, 3 );
        end else if( copy( s, 1, 7 ) = 'msgctxt' ) then begin
           _msgctxt :=  extractValue( s , length('msgctxt') + 1 );
        end else if( copy( s, 1, 5 ) = 'msgid' ) then begin
             _msgid :=  extractValue( s, length('msgid') + 1 );
        end else if( copy( s, 1, 6 ) = 'msgstr' ) then begin
             _msgstr :=  extractValue( s, length('msgstr') + 1 );
             self.Add( TPOItem.Create( _rttiInfo, _msgctxt, _msgid , _msgstr ) );
             // cleanup automat state
             _rttiInfo := '';
             _msgctxt := '';
             _msgid   := '';
             _msgstr  := '';
        end;
        inc(i);
     end;
   finally
       FreeAndNil( lst );
   end;
end;

var poCache: TPOCache = nil;

function TPOCache.FindItem( const tclassName: ansiString; from: Integer ): integer;
var i : Integer;
begin
   result := -1;
   for i :=  from to count - 1 do begin
     if( tclassName =  copy ( TPOItem( self[i] ).rttiInfo, 1, length( tclassName ) ) ) then begin
          result := i;
          exit;
      end;
   end;
end;


procedure split (const Delimiter: Char; Input: string; const Strings: TStrings);
begin
   Assert(Assigned(Strings)) ;
   Strings.Clear;
   Strings.StrictDelimiter := true;
   Strings.Delimiter := Delimiter;
   Strings.DelimitedText := Input;
end;

function FindMember(Instance:TObject;const Name:string):TInfoRec;
var p: pointer;
begin
   FillChar(result,Sizeof(result),0);
   if Instance = nil then Exit;

   try
     if Instance.InheritsFrom(TComponent) then
     begin
       if Uppercase ( ( Instance as TComponent ).Name ) = uppercase( name ) then begin
        result.irObject:=TObject(Instance);
        exit;
       end;

       p:=TComponent(Instance).FindComponent(Name);
       if p <> Nil then
       begin
          result.irObject:=TObject(p);
          exit;
       end;
     end;
   except
    On e:Exception do begin
       assert( false ); //zu-todo
    end;
   end;

   try
     Result.MPropInfo := GetPropInfo(PTypeInfo( Instance.ClassInfo ) ,Name);

     with Result do
     case PTypeInfo( Result.MPropInfo^.PropType )^.Kind of
     tkUnknown    :;
     tkInteger    :irInteger:=GetOrdProp(Instance,MPropInfo);
     tkChar       :irChar   :=Chr(GetOrdProp(Instance,MPropInfo));
     tkEnumeration:{To be realised};
     tkFloat      :irFloat  :=GetFloatProp(Instance,MPropInfo);
     tkString     :irString :=copy(GetStrProp(Instance,MPropInfo),1,255);
     tkSet        :{To be realised};
     tkClass      :Longint(irObject):=GetOrdProp(Instance,MPropInfo);
     tkObject     :Longint(irObject):=GetOrdProp(Instance,MPropInfo);
     tkMethod     :{To be Realised};
     tkWChar      :irWchar:=WideChar(GetOrdProp(Instance,MPropInfo));
     //tkLString    :{To be realised};
     //tkLWString   :{To be realised};
     //tkVariant    :{To be realised};
     end;
   except
      On e:Exception do begin
         assert( false ); //zu-todo
      end;
   end;
end;

function FindPOMemberRecursive(Instance:TObject;const DotSeparatedName:string; var last: ansiString):TInfoRec;
var list : TStringList;
var memberInfo : TInfoRec;
var i : integer;
var parentInstance: TObject;
begin
   FillChar(result,Sizeof(result),0);
   if( not assigned( Instance ) ) then  begin
      exit;
   end;

   list := TStringList.Create;
   try
     split ( '.',  DotSeparatedName, list );

     assert( uppercase(Instance.ClassName ) = uppercase( list[0] ) );
     parentInstance := Instance; // instance where member find to
     last := list[ list.Count - 1 ];
     for i := 1  to list.Count - 2  do begin
       memberInfo := FindMember( parentInstance, list[i] );
       parentInstance := memberInfo.irObject;
       assert( parentInstance is TObject )
     end;
     result := memberInfo;
   finally
      FreeAndNil( list );
   end;
end;

procedure LoadPoFile(const s: ansiString);
begin
   if poCache = nil then
      poCache := TPOcache.Create;

   poCache.Cleanup;
   poCache.ParseFile( s );
end;

procedure LocalizeInstance(Instance: TObject);
var clsname : ansistring;
var index:integer;
var item : TPOItem;
var infoRec: TInfoRec;
var last : ansiString ;
var Inst :TObject;
begin
   assert(  Assigned( instance ) );
   assert(  poCache <> nil );
   clsname := uppercase( instance.ClassName );

   last := '';
   index := 0;
   index := poCache.FindItem( clsname, index );
   while ( index  >= 0 ) do  begin
       item := TPoItem( poCache[ index ] );
       assert ( item is TPoItem );
       if( item.msgstr <> '' ) then begin
           infoRec := FindPOMemberRecursive( Instance, item.rttiInfo, last );
           Inst  :=  infoRec.irObject;
           assert( inst  <> nil );
           assert( inst  is TObject );
           SetStrProp(Inst, last, item.MsgStr );
       end;
      index := poCache.FindItem( clsname, index + 1 );
   end;
end;

finalization
   FreeAndNil( poCache );
end.

--- End code ---

Navigation

[0] Message Index

Go to full version