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.