AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi [Mehrsprachigkeit] String als Property/Eigenschaft verwenden
Thema durchsuchen
Ansicht
Themen-Optionen

[Mehrsprachigkeit] String als Property/Eigenschaft verwenden

Ein Thema von Partikelecho · begonnen am 23. Feb 2012 · letzter Beitrag vom 24. Feb 2012
 
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#5

AW: [Mehrsprachigkeit] String als Property/Eigenschaft verwenden

  Alt 23. Feb 2012, 11:00
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)='/debugthen
  begin
    {$I SetIfFind.txt}
  end;
end;



end.
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
 

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:41 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz