[Mehrsprachigkeit] String als Property/Eigenschaft verwenden

[Bummi]

Datenbankbasiert hätte ich folgendes anzubieten:

Delphi-Quellcode:

procedure TTemplate.Translate;
begin
{$IFDEF WriteTrans}
  WriteRTTITranslation(Self,Self.Classname,'');
{$ELSE}
  ReadRTTITranslation(DM.ADSLang, Self, 'D'); // anpassen auf Variable
{$ENDIF}
end;






unit Translation;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, TypInfo, ComCtrls, Menus;

  Procedure ReadRTTITranslation(Lang: TAdoDataset; TheForm: TForm; const Language: String);
  procedure ReadResourceTrans(Lang:TadoDataset;Const Language:String);
  Procedure WriteRTTITranslation(TheOwner:TComponent;const TheOwnerString,TheSubOwner:String);
  procedure WriteResourceTrans;

implementation

uses
  DMp, ConstsAndGlobals;


Procedure WriteRTTI(Const Owner,Comp,Prop,Value:String;IsTStrings:Boolean);
begin
  if not DM.AC.Connected then
    Exit;
  if Pos('..',Comp)=0 then
    DM.AC.Execute('P_AddUpdateFormLanguageValues '+QuotedStr(C_APPName)+','+
        QuotedStr(Owner)+','+QuotedStr(Comp)+','+QuotedStr(Prop)+','+IntToStr(Integer(IsTStrings))+','+QuotedStr(Value));
end;


Procedure ReadRTTITranslation(Lang: TAdoDataset; TheForm: TForm; const Language: String);
var
  TheComp  : TComponent;
  CN,CNP   : String;
  PropInfo : PPropInfo;
  cap,Prop : String;
begin
  if not Lang.Connection.Connected then Exit;

  Lang.Close;
  Lang.Parameters.ParamByName('Application').Value:=C_APPName;
  Lang.Parameters.ParamByName('FormClassName').Value:=TheForm.ClassName;
  Lang.Parameters.ParamByName('Language').Value:=Language;
  Lang.Open;
  While not Lang.Eof do
  begin
    TheComp := TheForm;
    try
    CN:=Lang.FieldByName('ComponentName').asString;

    if Length(CN)>0 then
      begin
        While (Pos('.',CN)>0) and Assigned(TheComp) do
          begin
          CNP:=Copy(CN,1,pos('.',CN)-1);
          CN:=Copy(CN,pos('.',CN)+1,Length(CN));
          if Pos('*',CNP)>0 then TheComp:=TheComp.Components[StrToInt(Copy(CNP,2,Length(CNP)))]
          else TheComp:=TheComp.FindComponent(CNP);
          end;
        if Assigned(TheComp) then
          begin
          if Pos('*',CN)>0 then TheComp:=TheComp.Components[StrToInt(Copy(CN,2,Length(CN)))]
          else TheComp:=TheComp.FindComponent(CN);
          end;
      end;
    IF Assigned(TheComp) then
      begin
        if Lang.FieldByName('IsClassType').asBoolean then
          begin
          PropInfo := GetPropInfo(TheComp,Lang.FieldbyName('Property').Value);
          if Assigned(PropInfo) then
            begin
            try
            if (not (TheComp is TMainMenu)) and (not (TheComp is TPopupMenu)) and  (not (TheComp is TPageControl)) then //and  ((not ((TheComp is TDBRadioGroup) or (TheComp is TRadioGroup)))) then
            TStrings(GetOrdProp(TheComp,PropInfo)).Text:=Lang.FieldbyName('Value').Value;
            except
              ON E:Exception do MessageDLG( E.Message+#13#10+TheComp.Name + ' - ' + Lang.FieldbyName('Property').Value,mtError,[mbok],0);
            end;
            end;
          end
        else
          begin
          cap:= Lang.FieldbyName('Value').Value;
          Prop:=Lang.FieldbyName('Property').Value;
          SetPropValue(TheComp,Lang.FieldbyName('Property').Value,Lang.FieldbyName('Value').Value);
          end;
      end;
    except
     ON E:Exception do
      MessageDLG( E.Message+#13#10+TheComp.Name + ' - ' + Lang.FieldbyName('Property').Value,mtError,[mbok],0);
    end;
    Lang.Next;
    end;

end;


procedure ReadResourceTrans(Lang:TadoDataset;Const Language:String);
const
  C_Resources='RESOURCE';
  Procedure SetIfFind(Const vname:String;Var Vari:String);
    begin
    if Lang.Locate('ComponentName',vname,[]) then Vari:=Lang.Fieldbyname('Value').Value;
    end;
begin
//  G_Language:=Language;
  if not Lang.Connection.Connected then Exit;
  Lang.Close;
  Lang.Parameters.ParamByName('Application').Value := C_APPName;
  Lang.Parameters.ParamByName('FormClassName').Value := C_Resources;
  Lang.Parameters.ParamByName('Language').Value := Language;
  Lang.Open;
  {$I SetIfFind.txt}
end;


Procedure WriteRTTITranslation(TheOwner:TComponent;const TheOwnerString,TheSubOwner:String);
Type
TParseValues=Array [0..5] of String;
Const
// properities which are interesting for translation
ParseValues:TParseValues=('Caption','Hint','DisplayLabel','Text','Lines','Items');
var
  PropInfo: PPropInfo;
  i,j:Integer;
  pv,TheComp,SB:String;
  isTStrings:Boolean;
begin
  if Length(TheSubOwner)=0 then   // collect properties of the form
    begin
      for j:=0 to High(ParseValues) do
              begin
              isTStrings:=false;
              PropInfo := GetPropInfo(TheOwner.ClassInfo,ParseValues[j]);
              if Assigned(PropInfo) then
                 begin
                     if PropType(TheOwner,ParseValues[j])=tkClass then
                       begin
                       if (TPersistent(GetOrdProp(TheOwner,PropInfo)) is TStrings) then PV:=TStrings(GetOrdProp(TheOwner,PropInfo)).Text;
                       isTStrings:=True;
                       end
                     else pv:=GetPropValue(TheOwner,ParseValues[j],false);
                     if length(PV)>0 then
                        begin
                        WriteRTTI(TheOwnerString,'',ParseValues[j],pv,isTStrings);
                        end;

                 end;
              end;
    end;
  For i:=0 to TheOwner.ComponentCount-1 do   // collect properties of components and subcomponents of the form
      begin
          begin
          for j:=0 to High(ParseValues) do
              begin
              isTStrings:=false;
              PropInfo := GetPropInfo(TheOwner.Components[i].ClassInfo,ParseValues[j]);
              if Assigned(PropInfo) then
                 begin
                 if TheOwner.Components[i].ComponentCount>0 then      // recursion needed
                    begin
                    if Length(TheSubOwner)>0 then SB:=TheSubOwner+'.'+TheOwner.Components[i].Name else SB:=TheOwner.Components[i].Name;
                    WriteRTTITranslation(TheOwner.Components[i],TheOwnerString,SB);
                    end;
                 //else
                     begin
                     if PropType(TheOwner.Components[i],ParseValues[j])=tkClass then
                       begin
                       if (TPersistent(GetOrdProp(TheOwner.Components[i],PropInfo)) is TStrings) then PV:=TStrings(GetOrdProp(TheOwner.Components[i],PropInfo)).Text;
                       isTStrings:=True;
                       end
                     else pv:=GetPropValue(TheOwner.Components[i],ParseValues[j],false);
                     if length(PV)>0 then
                        begin
                        if TheOwner.Components[i].name<>'' then TheComp:=TheOwner.Components[i].name else TheComp:='*'+IntToStr(i);
                        if Length(TheSubOwner)>0 then TheComp:=TheSubOwner+'.'+TheComp;
                        WriteRTTI(TheOwnerString,TheComp,ParseValues[j],pv,isTStrings);
                        end;
                     end;

                 end;
              end;
          end;
      end;
end;



procedure WriteResourceTrans;
const
  C_Resources='RESOURCE';
  Procedure SetIfFind(const CName:String; Value:String);
  begin
    WriteRTTI(C_Resources, CName, '',Value,false);
  end;
begin
  if Paramstr(1)='/debug' then
  begin
    {$I SetIfFind.txt}
  end;
end;



end.