Multilanguage Delphi Programm
Sprache:
Delphi XE6 VCL
Inhalt:
In dieser einfachen Unit "SpracheUnit.pas" ist eine Klasse erstellt worden, mit der man sein Programm auf Multilanguage umbauen kann. Die Unit ist selbst geschrieben und darf natürlich nach Belieben verändert/angepasst werden. Sie basiert auf UNICODE, es sind also auch Sprachen mit anderen Schriftsätzen möglich.
Die Funktionsweise habe ich in einem kleinen Beispielprogramm mit dargelegt.
Die Klasse ist sehr einfach aufgebaut und sofort benutzbar. Lediglich die verschiedenen Komponenten müssen noch eingepflegt werden. Jeder, der ein bisschen programmieren kann findet leicht die 2 Stellen, an denen alle Componenten eingebaut werden können.
Quellcode:
// SpracheUnit
unit SpracheUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.StrUtils, Vcl.StdCtrls, Vcl.Menus;
type
TSprache = class
private
{ Private-Deklarationen }
LoadedLanguage : string;
LoadedLanguageKennung2 : string;
EintragListe : array of record
Name:string;
Wert:string;
end;
function GetEintragIndex(Name:string):integer;
Procedure SaveComponentenToStringlist(wohin:tstringlist;Quelle:TComponent);
Procedure SucheUndSetzeComponente(FPfad,wert:string;Quelle:TComponent);
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); overload;
function RegisterIndividualText(Name:string;Wert:string):boolean;
function LoadedLanguageNameLong:string;
function LoadLanguageFromFile(Dateiname:string):boolean;
function LoadLanguageFromRessource(const ResName: String):boolean;
function LoadLanguageFromString(Quelle: String):boolean;
function Load_Name_And_Name2_FormFile(Dateiname: String;var NameK:string;var NameL:string):boolean;
procedure SaveLanguageToFile(Dateiname:string;NameK:string='';NameL:string='');
procedure SaveLanguageToString(var Ziel:string;NameK:string='';NameL:string='');
function GetText(Name:string):string;
function GetTextF(Name:string; const Args: array of const):string;
end;
var Sprache:TSprache;
implementation
constructor TSprache.Create(AOwner: TComponent);
begin
inherited create;
setlength(EintragListe,0);
LoadedLanguage:='Standard';
LoadedLanguageKennung2:='ST';
end;
function TSprache.LoadedLanguageNameLong:string;
begin
result:=LoadedLanguage+' ('+LoadedLanguageKennung2+')';
end;
function TSprache.GetEintragIndex(Name:string):integer;
var i:integer;
begin
result:=-1;
for i:=0 to length(EintragListe)-1 do
if EintragListe[i].Name='individuell.'+Name then
begin
result:=i;
exit;
end;
end;
function TSprache.RegisterIndividualText(Name:string;Wert:string):boolean;
var i:integer;
begin
Name:='individuell.'+Name;
result:=false;
i:=GetEintragIndex(Name);
if (i=-1) and (pos('=',Name)=0) and (pos('[',Name)=0) then
begin
result:=true;
setlength(EintragListe,length(EintragListe)+1);
EintragListe[length(EintragListe)-1].Name:=Name;
EintragListe[length(EintragListe)-1].Wert:=Wert;
end else showmessage('Sprache: doppelter/falscher Eintrag "'+Name+'"');
end;
function ReplaceStr_own(source,vonStr,zuStr:string):string;
var found,sPos,vonStr_len,zuStr_len:cardinal;
begin
result:=source;
sPos:=1;
vonStr_len:=length(vonStr);
zuStr_len:=length(zuStr);
repeat
found:=posEx(vonStr,result,sPos);
if found=0 then break;
spos:=found+zuStr_len;
Delete(result,found,vonStr_len);
Insert(zuStr,result,found);
until found=0;
end;
const EscapeChar = '?';
function hextostr(was:string):string;
var zahler: integer;
hexstr:string;
begin
result:='';
try
hexstr:='';
if length(was) mod 4 = 0 then
for zahler:=low(was) to high(was) do
begin
hexstr:=hexstr+was[zahler];
if length(hexstr)=4 then
begin
result:=result+Char(strtoint('$'+hexstr));
hexstr:='';
end;
end;
except
result:='';
end;
end;
function strtohex(was:string):string;
var zahler:integer;
begin
result:='';
for zahler:=low(was) to high(was) do
result:=result+inttohex(ord(was[zahler]),4);
end;
Function EscapeBIN(Text:string):string;
var c:Char;
z:byte;
begin
Result:=Text;
c:=EscapeChar; Result:=ReplaceStr_own(Result,c,EscapeChar+strtohex(c));
for z:=0 to 31 do begin c:=chr(z); Result:=ReplaceStr_own(Result,c,EscapeChar+strtohex(c)); end;
c:='\'; Result:=ReplaceStr_own(Result,c,EscapeChar+strtohex(c));
c:='"'; Result:=ReplaceStr_own(Result,c,EscapeChar+strtohex(c));
c:=#39; Result:=ReplaceStr_own(Result,c,EscapeChar+strtohex(c));
end;
Function unEscapeBIN(Text:string):string;
var c:Char;
z:byte;
begin
Result:=Text;
c:='\'; Result:=ReplaceStr_own(Result,EscapeChar+strtohex(c),c);
c:='"'; Result:=ReplaceStr_own(Result,EscapeChar+strtohex(c),c);
c:=#39; Result:=ReplaceStr_own(Result,EscapeChar+strtohex(c),c);
for z:=0 to 31 do begin c:=chr(z); Result:=ReplaceStr_own(Result,EscapeChar+strtohex(c),c); end;
c:=EscapeChar; Result:=ReplaceStr_own(Result,EscapeChar+strtohex(c),c);
end;
Procedure TSprache.SaveComponentenToStringlist(wohin:tstringlist;Quelle:TComponent);
Procedure AddComponent(Quelle:TComponent;Pfad:string);
var str:string;
begin
if Quelle.Name='' then exit;
str:='';
if (Quelle is TApplication) then
begin
str:='.Title='+EscapeBIN((Quelle as TApplication).Title);
end
else if (Quelle is TMenuItem) then
begin
if (Quelle as TMenuItem).Caption='-' then str:='' // Trennstrich abfangen
else str:='.Caption='+EscapeBIN((Quelle as TMenuItem).Caption);
end
else if (Quelle is TSaveDialog) then
begin
str:='.Filter='+EscapeBIN((Quelle as TSaveDialog).Filter);
end
else if (Quelle is TOpenDialog) then
begin
str:='.Filter='+EscapeBIN((Quelle as TOpenDialog).Filter);
end
else if (Quelle is TCheckbox) then
begin
str:='.Caption='+EscapeBIN((Quelle as TCheckbox).Caption);
end
else if (Quelle is TForm) then
begin
str:='.Caption='+EscapeBIN((Quelle as TForm).Caption);
end
else if (Quelle is TGroupbox) then
begin
str:='.Caption='+EscapeBIN((Quelle as TGroupbox).Caption);
end
else if (Quelle is TLabel) then
begin
str:='.Caption='+EscapeBIN((Quelle as TLabel).Caption);
end
else if (Quelle is TButton) then
begin
str:='.Caption='+EscapeBIN((Quelle as TButton).Caption);
end;
if str<>'' then wohin.Add(Pfad+str);
end;
Procedure GetComponenten(Quelle:TComponent;Pfad:string);
var i:integer;
begin
for i:=0 to Quelle.ComponentCount-1 do
if Quelle.Components[i].ComponentCount>0 then
begin
GetComponenten(Quelle.Components[i],Pfad+'.'+Quelle.Components[i].Name);
end else AddComponent(Quelle.Components[i],Pfad+'.'+Quelle.Components[i].Name);
AddComponent(Quelle,Pfad);
end;
begin
GetComponenten(Quelle,'');
end;
var NichtWeiter:boolean;
Procedure TSprache.SucheUndSetzeComponente(FPfad,wert:string;Quelle:TComponent);
Procedure CheckComponent(Quelle:TComponent;Pfad:string);
begin
if NichtWeiter=true then exit;
if Quelle.Name='' then exit;
if pos(Pfad,FPfad)<>1 then exit;
Pfad:=copy(FPfad,length(Pfad)+2,99999);
if pos('.',Pfad)>0 then exit;
NichtWeiter:=true;
if (Quelle is TApplication) then
begin
if Pfad='Title' then (Quelle as TApplication).Title:=Wert
end
else if (Quelle is TSaveDialog) then
begin
if Pfad='Filter' then (Quelle as TSaveDialog).Filter:=Wert
end
else if (Quelle is TOpenDialog) then
begin
if Pfad='Filter' then (Quelle as TOpenDialog).Filter:=Wert
end
else if (Quelle is TMenuItem) then
begin
if Pfad='Caption' then (Quelle as TMenuItem).Caption:=Wert
end
else if (Quelle is TCheckbox) then
begin
if Pfad='Caption' then (Quelle as TCheckbox).Caption:=Wert
end
else if (Quelle is TForm) then
begin
if Pfad='Caption' then (Quelle as TForm).Caption:=Wert
end
else if (Quelle is TGroupbox) then
begin
if Pfad='Caption' then (Quelle as TGroupbox).Caption:=Wert
end
else if (Quelle is TLabel) then
begin
if Pfad='Caption' then (Quelle as TLabel).Caption:=Wert
end
else if (Quelle is TButton) then
begin
if Pfad='Caption' then (Quelle as TButton).Caption:=Wert
end;
end;
Procedure GetComponenten(Quelle:TComponent;Pfad:string);
var i:integer;
begin
if NichtWeiter=true then exit;
for i:=0 to Quelle.ComponentCount-1 do
begin
if NichtWeiter=true then exit;
if Quelle.Components[i].ComponentCount>0 then
begin
GetComponenten(Quelle.Components[i],Pfad+'.'+Quelle.Components[i].Name);
end else CheckComponent(Quelle.Components[i],Pfad+'.'+Quelle.Components[i].Name);
end;
CheckComponent(Quelle,Pfad);
end;
begin
NichtWeiter:=false;
GetComponenten(Quelle,'');
end;
function TSprache.LoadLanguageFromFile(Dateiname:string):boolean;
var Datei:TStringlist;
i:integer;
str:string;
name,wert:string;
begin
result:=false;
if fileexists(Dateiname)=false then exit;
try
datei:=TStringlist.Create;
datei.LoadFromFile(Dateiname,TEncoding.Unicode);
LoadedLanguage:='';
LoadedLanguageKennung2:='';
for i:=0 to datei.Count-1 do
begin
if pos('[Language]=',datei[i])=1 then LoadedLanguage:=copy(datei[i],pos('=',datei[i])+1,999999);
if pos('[LanguageKennung]=',datei[i])=1 then LoadedLanguageKennung2:=copy(datei[i],pos('=',datei[i])+1,999999);
if pos('[Start]',datei[i])=1 then break;
end;
if (datei.Count>4) and (LoadedLanguage<>'') and (length(LoadedLanguageKennung2)=2) then result:=true;
if result=true then
begin
setlength(EintragListe,0);
for i:=i to datei.Count-1 do
begin
if pos('[End]',datei[i])=1 then break;
str:=datei[i];
if (trim(str)<>'') and (pos('=',str)>0) then
begin
name:=copy(str,1,pos('=',str)-1);
wert:=unEscapeBIN(copy(str,pos('=',str)+1,999999999));
if pos('individuell.',name)=1 then
begin
setlength(EintragListe,length(EintragListe)+1);
EintragListe[length(EintragListe)-1].Name:=Name;
EintragListe[length(EintragListe)-1].Wert:=Wert;
end else SucheUndSetzeComponente(name,wert,application);
end;
end;
end;
finally
datei.Free;
end;
end;
function TSprache.LoadLanguageFromRessource(const ResName: String):boolean;
var Datei:TStringlist;
i:integer;
str:string;
name,wert:string;
RS:TResourceStream;
begin
result:=false;
try
try
RS:=TResourceStream.Create(HInstance,ResName,RT_RCDATA);
except
RS.Free;
exit;
end;
if RS.Size<10 then exit;
datei:=TStringlist.Create;
datei.LoadFromStream(RS);
LoadedLanguage:='';
LoadedLanguageKennung2:='';
for i:=0 to datei.Count-1 do
begin
if pos('[Language]=',datei[i])=1 then LoadedLanguage:=copy(datei[i],pos('=',datei[i])+1,999999);
if pos('[LanguageKennung]=',datei[i])=1 then LoadedLanguageKennung2:=copy(datei[i],pos('=',datei[i])+1,999999);
if pos('[Start]',datei[i])=1 then break;
end;
if (datei.Count>4) and (LoadedLanguage<>'') and (length(LoadedLanguageKennung2)=2) then result:=true;
if result=true then
begin
setlength(EintragListe,0);
for i:=i to datei.Count-1 do
begin
if pos('[End]',datei[i])=1 then break;
str:=datei[i];
if (trim(str)<>'') and (pos('=',str)>0) then
begin
name:=copy(str,1,pos('=',str)-1);
wert:=unEscapeBIN(copy(str,pos('=',str)+1,999999999));
if pos('individuell.',name)=1 then
begin
setlength(EintragListe,length(EintragListe)+1);
EintragListe[length(EintragListe)-1].Name:=Name;
EintragListe[length(EintragListe)-1].Wert:=Wert;
end else SucheUndSetzeComponente(name,wert,application);
end;
end;
end;
finally
RS.Free;
datei.Free;
end;
end;
function TSprache.LoadLanguageFromString(Quelle: String):boolean;
var Datei:TStringlist;
i:integer;
str:string;
name,wert:string;
begin
result:=false;
try
if length(Quelle)<10 then exit;
datei:=TStringlist.Create;
datei.Text:=Quelle;
LoadedLanguage:='';
LoadedLanguageKennung2:='';
for i:=0 to datei.Count-1 do
begin
if pos('[Language]=',datei[i])=1 then LoadedLanguage:=copy(datei[i],pos('=',datei[i])+1,999999);
if pos('[LanguageKennung]=',datei[i])=1 then LoadedLanguageKennung2:=copy(datei[i],pos('=',datei[i])+1,999999);
if pos('[Start]',datei[i])=1 then break;
end;
if (datei.Count>4) and (LoadedLanguage<>'') and (length(LoadedLanguageKennung2)=2) then result:=true;
if result=true then
begin
setlength(EintragListe,0);
for i:=i to datei.Count-1 do
begin
if pos('[End]',datei[i])=1 then break;
str:=datei[i];
if (trim(str)<>'') and (pos('=',str)>0) then
begin
name:=copy(str,1,pos('=',str)-1);
wert:=unEscapeBIN(copy(str,pos('=',str)+1,999999999));
if pos('individuell.',name)=1 then
begin
setlength(EintragListe,length(EintragListe)+1);
EintragListe[length(EintragListe)-1].Name:=Name;
EintragListe[length(EintragListe)-1].Wert:=Wert;
end else SucheUndSetzeComponente(name,wert,application);
end;
end;
end;
finally
datei.Free;
end;
end;
procedure TSprache.SaveLanguageToString(var Ziel:string;NameK:string='';NameL:string='');
var Datei:TStringlist;
i:integer;
begin
try
Ziel:='';
if (NameK='') or (NameL='') then
begin
NameK:=LoadedLanguageKennung2;
NameL:=LoadedLanguage;
end;
datei:=TStringlist.Create;
datei.Clear;
datei.Add('[Language]='+NameL);
datei.Add('[LanguageKennung]='+NameK);
datei.Add('[Start]');
for i:=0 to length(EintragListe)-1 do datei.Add(EintragListe[i].Name+'='+EscapeBIN(EintragListe[i].Wert));
SaveComponentenToStringlist(datei,application);
datei.Add('[End]');
try Ziel:=datei.Text; except end;
finally
datei.Free;
end;
end;
procedure TSprache.SaveLanguageToFile(Dateiname:string;NameK:string='';NameL:string='');
var Datei:TStringlist;
i:integer;
begin
try
if (NameK='') or (NameL='') then
begin
NameK:=LoadedLanguageKennung2;
NameL:=LoadedLanguage;
end;
datei:=TStringlist.Create;
datei.Clear;
datei.Add('[Language]='+NameL);
datei.Add('[LanguageKennung]='+NameK);
datei.Add('[Start]');
for i:=0 to length(EintragListe)-1 do datei.Add(EintragListe[i].Name+'='+EscapeBIN(EintragListe[i].Wert));
SaveComponentenToStringlist(datei,application);
datei.Add('[End]');
try datei.SaveToFile(Dateiname,TEncoding.Unicode); except end;
finally
datei.Free;
end;
end;
function TSprache.Load_Name_And_Name2_FormFile(Dateiname: String;var NameK:string;var NameL:string):boolean;
var Datei:TStringlist;
i:integer;
str:string;
name,wert:string;
begin
result:=false;
NameK:='';
NameL:='';
if fileexists(Dateiname)=false then exit;
try
datei:=TStringlist.Create;
datei.LoadFromFile(Dateiname);
if length(datei.Text)<10 then exit;
for i:=0 to datei.Count-1 do
begin
if pos('[Language]=',datei[i])=1 then NameL:=copy(datei[i],pos('=',datei[i])+1,999999);
if pos('[LanguageKennung]=',datei[i])=1 then NameK:=copy(datei[i],pos('=',datei[i])+1,999999);
if pos('[Start]',datei[i])=1 then break;
end;
finally
if (NameK<>'') and (NameL<>'') then result:=true;
datei.Free;
end;
end;
function TSprache.GetText(Name:string):string;
var i:integer;
begin
result:='no text';
i:=GetEintragIndex(Name);
if i<>-1 then result:=EintragListe[i].Wert;
end;
function TSprache.GetTextF(Name:string; const Args: array of const):string;
var i:integer;
begin
result:='no text';
i:=GetEintragIndex(Name);
if i<>-1 then result:=format(EintragListe[i].Wert,Args);
end;
initialization
Sprache:=TSprache.Create(application);
Sprache.RegisterIndividualText('unit1.time','the current time ist %s.');
finalization
Sprache.free;
end.
// Beispielprogramm
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, SpracheUnit;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
showmessage(Sprache.GetTextF('unit1.time',[datetimetostr(now)]));
// GetTextF ist wie format
// GetText ist reiner Text
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Sprache.LoadLanguageFromFile('Deutsch.lang');
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Sprache.SaveLanguageToFile('Sprache1.lang');
end;
end.
