Реализовать перевод в приложениях Delphi можно реализовать несколькими способами:

• стандартный способ локализации.
• локализация с помощью текстовых ресурсов: ini-файл или xml-файл.

Стандартный способ локализации приложений

С помощью ресурсов на нужном языке (с помощью меню Project -> Languages). Этот способ часто описывается в книгах по Delphi, а так же в большом количестве статей в интернете. Поэтому, этот способ не будем описывать в этой статье.

Этот способ имеет как преимущества, так и недостатки.

К преимуществам, можно отнести: скорость работы данной реализации, а так же то, что этот способ реализован в самом Delphi.

Недостатки:

• Нужно переводить прямо в среде разработки Delphi.
• По умолчанию, извлекается ресурс, того языка, какой установлен в Windows.

Локализация с помощью текстовых ресурсов

К сожалению, локализация с помощью текстовых ресурсов в Delphi не предусмотрена. Хотя, иногда данный способ может быть более предпочтительным, чем перевод с помощью ресурсов, реализованный в Delphi.

К преимуществам данного способа можно отнести:
- Возможность перевода без среды Delphi. Более того, из любого текстового редактора. - Как следствие предыдущего пункта – возможность перевода сот рудниками, не знаючими Delphi и не умеюми в нем работать.
- Совместимость разных версий с разными версиями программы.

К недостаткам данного способа можно отнести:
- Меньшую скорость работы, чем через ресурсы.
- Не реализован данный способ в стандартной поставке Delphi.
- Больший размер файла, чем ресурсного файла.

В текстовый формат можно сохранять в виде: ini-файла, xml-файла или текст с заданными разделителями.

Есть компоненты, которые реализуют подобную задачу, но чаще всего, эти компоненты платные.

В данной статье мы опишем способ локализации в формате xml.

Локализация с помощью xml-файлов

Для локализации, воспользуемся некоторыми из функций проекта XMLWorks: http://www.DelphiHome.com/xml

Прежде всего, нужно определиться с тем, что мы переводим.

Мы переводим:

- строковые ресурсы;

- вариантные типы;

- символьные типы;

Все остальные типы данных мы не переводим.

Процесс перевода можно разделить на 2 этапа:

1-й этап. Генерация текстового файла для последующего перевода. Сохранение его. Перевод. Перенос в каталог соответствующего языка.

2-й этап. Загрузка в приложение из xml-файла.

Генерация текстового файла для последующего перевода

Для того, чтобы сгенерировать файл для перевода нам необходимо перебрать все компоненты и все свойства, сформировать текстовый файл.

Необходимо учитывать, что на форме могут находиться не только компоненты, но и фреймы, которые сами в себя включают другие компоненты.

Так же могут быть компоненты, которые мы не хотим переводить. Их нужно исключить из перевода. Так, например, не желательно переводить TDBEdit, TDBDateTimeEditE, TDBLookupComboboxEh, т.к. нам не нужно переводить информацию, взятую из базы данных.

Ниже, приводим функцию, которая формирует xml-файл для перевода.

function GenSQLLang(SelfInp: TObject): String;
Var i, b: integer;
BandTmp: TcxGridDBBandedTableView;
begin

 if (SelfInp is TComponent) then
Begin

 With (SelfInp as TComponent) Do
Begin
Result:=ObjectToXMLElements_Lang(SelfInp,-4);

 Result:=Result+Chr(13)+';
 

for i:=0 to ComponentCount-1 Do
begin
 

if (Trim(Components[i].Name)<>')And
(not((RusCompare(Components[i].ClassName,'TSaveDBGridEh'))
Or(RusCompare(Components[i].ClassName,'TpFIBTransaction'))
Or(RusCompare(Components[i].ClassName,'TpFIBStoredProc'))
Or(RusCompare(Components[i].ClassName,'TDBEdit'))
Or(RusCompare(Components[i].ClassName,'TDBDateTimeEditEh'))
Or(RusCompare(Components[i].ClassName,'TDBLookupComboboxEh'))
Or(RusCompare(Components[i].ClassName,'TDBComboBoxEh'))
)) then
begin
Result:=Result+Chr(13)
+'<'+Components[i].Name+'>'+Chr(13)+ObjectToXMLElements_Lang(Components[i],4)
+'+Chr(13);

 

 end;
end;

 Result:=Result+'+Chr(13)+Chr(13);

 End;
End;
end;

Функция для формирования xml для заданной компоненты:

function ObjectToXMLElements_Lang(const aObject:TObject; Space_Inp: integer): String;
var
i : Integer;
s : string;
StringList : TStringList;
Props: TList;
IsLangSet: Boolean;
begin
result := ';

 StringList := TStringList.Create;
try

 Props := GetPropertyList(aObject.ClassInfo);
try

 for i := 0 to Props.Count-1 do
begin

 s := GetPropAsString_Lang(AObject, PPropInfo(Props.Items[i]), IsLangSet, Space_Inp+4);
 

 if (IsLangSet)And(UpperCase(PPropInfo(Props.Items[i]).Name)<>UpperCase('Name'))And(Trim(PPropInfo 
 (Props.Items[i]).Name)<>') then
 StringList.Add(Space(Space_Inp)+'<' + PPropInfo(Props.Items[i]).Name + '>' + s + Space(Space_Inp)+'
 end;
result := StringList.Text;

 finally
 Props.Free;
end;

 finally
 StringList.Free;
end;

 end; 

Функция для формирования xml для заданного свойства:

function GetPropAsString_Lang(const Instance: TObject; const PropInfo: PPropInfo; 
Var IsLangSet: Boolean; Space_Inp: Integer): string;
var
 ObjectProp : TObject;
Intf: IXMLWorksObject;
begin
 

if (not Assigned(PropInfo^.PropType^))Or(UpperCase(Trim(PropInfo^.PropType^.Name))='NAME')
then Exit;
 

result := ';
IsLangSet:=False;

 case PropInfo^.PropType^.Kind of

 tkString,
tkLString,
tkWString:
Begin
 IsLangSet:=True;
 

 if AnsiSameText(PropInfo^.PropType^.Name, 'XMLString') then
 result := Trim(GetStrProp(Instance, PropInfo))
 else if AnsiSameText(PropInfo^.PropType^.Name, 'XMLMIMEString') then
 result := Base64Encode(GetStrProp(Instance, PropInfo))
 else
 begin
 result := StrToXML(Trim(GetStrProp(Instance, PropInfo)));
 end;
End;

 tkInt64: ;
tkSet,
tkInteger: ;
tkFloat: ;
tkVariant:
begin
 IsLangSet:=True;
 

 if GetVariantProp(Instance, PropInfo)=null
 then result := StrToXML(')
 else result := VariantToXML(Trim(GetVariantProp(Instance, PropInfo)));
end;

 tkChar,
tkWChar:
begin
 IsLangSet:=True;
 result := StrToXML(Chr(GetOrdProp(Instance, PropInfo)));
end;

 tkEnumeration: ;

 tkClass:
begin
end;

 tkInterface:
begin
 IsLangSet:=True;
 result := InterfaceToXML(GetIntfProp_Lang(Instance, PropInfo));
end;

 end;
end; 

Функции, которые используются в данном коде:

function GetIntfProp_Lang(Instance: TObject; PropInfo: PPropInfo): IUnknown;
asm

 { -> EAX Pointer to instance }
{ EDX Pointer to property info }
{ ECX Pointer to result interface }
PUSH ESI
PUSH EDI
MOV EDI,EDX

 MOV EDX,[EDI].TPropInfo.Index { pass index in EDX }
CMP EDX,$80000000
JNE @@hasIndex
MOV EDX,ECX { pass value in EDX }
@@hasIndex:
MOV ESI,[EDI].TPropInfo.GetProc
CMP [EDI].TPropInfo.GetProc.Byte[3],$FE
JA @@isField

 JB @@isStaticMethod
@@isVirtualMethod:
MOVSX ESI,SI { sign extend slot offset }
ADD ESI,[EAX] { vmt + slot offset }
CALL DWORD PTR [ESI]
JMP @@exit

 @@isStaticMethod:
CALL ESI
 

JMP @@exit

@@isField:
AND ESI,$00FFFFFF
ADD EAX, ESI
MOV EDX,[EAX]
MOV EAX, ECX
CALL AssignIntf

 @@exit:
POP EDI
POP ESI
end;


 function GetIntfProp(Instance: TObject; PropInfo: PPropInfo): IUnknown;
asm

 { -> EAX Pointer to instance }
{ EDX Pointer to property info }
{ ECX Pointer to result interface }

 PUSH ESI
PUSH EDI
MOV EDI,EDX

 MOV EDX,[EDI].TPropInfo.Index { pass index in EDX }
CMP EDX,$80000000
JNE @@hasIndex
MOV EDX,ECX { pass value in EDX }
@@hasIndex:
MOV ESI,[EDI].TPropInfo.GetProc
CMP [EDI].TPropInfo.GetProc.Byte[3],$FE
JA @@isField
JB @@isStaticMethod
@@isVirtualMethod:

 MOVSX ESI,SI { sign extend slot offset }
ADD ESI,[EAX] { vmt + slot offset }
CALL DWORD PTR [ESI]
JMP @@exit
@@isStaticMethod:
CALL ESI

 JMP @@exit
 

@@isField:
AND ESI,$00FFFFFF
ADD EAX, ESI
MOV EDX,[EAX]
MOV EAX, ECX
CALL AssignIntf

 @@exit:
POP EDI
POP ESI

 end;

Загрузка в приложение из xml-файла

Нам необходимо загрузить текстовый файл, декодировать информацию в нем и установить свойства.

Итак, процедура декодирования текстового файла:

Procedure DecodeSQLLang(SelfInp: TObject;StrInp: String);
Var PosTmp, PosTmp2: integer;
i: integer;
StrTmp: String;
begin
 

PosTmp:=0;

if SelfInp is TComponent then
With SelfInp as TComponent Do
Begin

 PosTmp:=Pos('ComponentsForm', StrInp);

if PosTmp=0
then StrTmp:=Copy(StrInp,1,Length(StrInp))
else StrTmp:=Copy(StrInp,1,PosTmp-2);
 

setXMLObject_Lang(SelfInp, StrInp);

 for i:=0 to ComponentCount-1 Do
begin

 if (Trim(Components[i].Name)<>')And
(not((RusCompare(Components[i].ClassName,'TSaveDBGridEh'))
Or(RusCompare(Components[i].ClassName,'TpFIBTransaction'))
Or(RusCompare(Components[i].ClassName,'TpFIBStoredProc'))
Or(RusCompare(Components[i].ClassName,'TDBEdit'))
Or(RusCompare(Components[i].ClassName,'TDBDateTimeEditEh'))
Or(RusCompare(Components[i].ClassName,'TDBLookupComboboxEh'))
Or(RusCompare(Components[i].ClassName,'TDBComboBoxEh'))
)) then
begin
 StrTmp:=RFastParseTagXML(StrInp,Components[i].Name);
 setXMLObject_Lang(Components[i], StrTmp);
end;

 end;

 End;

end;

Получение текста между тегами:

function RFastParseTagXML(const Source, Tag: AnsiString{; var Index: Integer}):
AnsiString;
var
 NestLevel: Integer;
 StartTag, StopTag: AnsiString;
 StartLen, StopLen, SourceLen: Integer;
 StartIndex, StopIndex: Integer;

 begin
 

SourceLen := Length(Source);
StartIndex := 0;
result := ';

 if (StartIndex < SourceLen) then
begin
StartTag := '<' + Tag + '<';
StartLen := Length(StartTag);

 if StartLen < 2 then
begin
 StopTag := '
 StopLen := Length(StopTag);
 StartIndex := Pos(StartTag,Source);
 StopIndex := Pos(StopTag,Source);
 result := Copy(Source, StartIndex+StartLen, StopIndex-StartIndex-StartLen{- 1});
end;

 end;

 end; 

Установка свойств:

procedure setPropAsString_Lang(Instance: TObject; PropInfo: PPropInfo; const value :
string);
var
ObjectProp : TObject;
Intf: IXMLWorksObject;
vTemp : variant;
StrTmp: String;
begin

 // No property
if (PropInfo = Nil) OR (value = ') or
// a read only simple type
((PropInfo^.SetProc = NIL) and not (PropInfo^.PropType^.Kind in [tkClass, tkInterface]))

 then
exit;

case PropInfo^.PropType^.Kind of

 tkString,
tkLString,
tkWString:
if AnsiSameText(PropInfo^.PropType^.Name, 'XMLString') then
 SetStrProp(Instance, PropInfo, Value)
else if AnsiSameText(PropInfo^.PropType^.Name, 'XMLMIMEString') then
 SetStrProp(Instance, PropInfo, Base64Decode(Value))
else
 SetStrProp(Instance, PropInfo, XMLToStr(Value));
 

tkSet, tkInteger:
if AnsiSameText(PropInfo^.PropType^.Name, 'XMLRGBTColor') then
 SetOrdProp(Instance, PropInfo, SwapRandB(StrToInt(XMLToStr(Value))))
else
 SetOrdProp(Instance, PropInfo, StrToInt(XMLToStr(Value)));
 

tkFloat:;

SetFloatProp(Instance, PropInfo, StrToFloat(XMLToStr(Value)));

tkVariant:
begin
 vTemp := GetVariantProp(Instance,PropInfo);
 XMLToVariant(value,vTemp);
 SetVariantProp(Instance, PropInfo, vTemp);
end;

 tkInt64: SetInt64Prop(Instance, PropInfo, StrToInt64(XMLToStr(Value)));
 

tkChar,
tkWChar:
begin
StrTmp:=XMLToStr(Value);

 if Length(StrTmp)>0 then
 SetOrdProp(Instance, PropInfo, Ord({XMLToStr(Value)}StrTmp[1]));

 end;

 tkEnumeration: SetOrdProp(Instance, PropInfo, GetEnumValue( PropInfo^.PropType^, XMLToStr(Value)));

tkClass :
begin
try

 ObjectProp := TObject(GetOrdProp(Instance, PropInfo));
 

if Assigned(ObjectProp) then
begin

 if ObjectProp.GetInterface(IXMLWorksObject, Intf) then
Intf.ElementText := Value
 else if (ObjectProp is TXMLCollection) then
 TXMLCollection(ObjectProp).ElementText := Value
 else if (ObjectProp is TXMLCollectionItem) then
 TXMLCollectionItem(ObjectProp).ElementText := Value
 else if (ObjectProp is TXMLObject) then
 TXMLObject(ObjectProp).ElementText := Value
 else if (ObjectProp is TXMLList) then
 TXMLList(ObjectProp).ElementText := Value
 else if (ObjectProp is TStrings) then
 TStrings(ObjectProp).CommaText := XMLToStr(Value)
 

end;

 except
 on e: Exception do
 raise EXMLException.Create('(' + e.Message + ')Error with property - ' + PropInfo^.Name);
end;

 end;

 tkInterface:
XMLtoInterface(Value,GetIntfProp(Instance, PropInfo));

 {
Types not supported :
tkRecord
tkArray
tkDynArray
tkMethod
tkUnknown
}
 

end;

 end;

Установка компонента:

procedure setXMLObject_Lang(Instance: TObject; p_sXML: AnsiString);
var
 CurrentTagIndex, OverAllIndex: Integer;
 CurrentTag, CurrentTagContent :string;
begin
 try
 CurrentTagIndex := 1;
 OverallIndex := 1;

 repeat
 CurrentTag := FastParseTag(p_sXML, '<' , '>', OverallIndex);
 CurrentTagContent := FastParseTagXML(p_sXML, CurrentTag, CurrentTagIndex);
 

 if (Length(CurrentTag) > 0) then
 SetPropAsString_Lang(Instance, GetPropInfo(Instance.ClassInfo, CurrentTag), CurrentTagContent);
 
 

 OverAllIndex := CurrentTagIndex;
 until (OverAllIndex<1) or (OverAllIndex > Length(p_sXML));

 except
 on EXMLException do
 raise;
 on e : Exception do
 raise EXMLException.Create('(' + e.Message + ')Error Processing XML - '
 +CurrentTag+' ('+CurrentTagContent+') '+iif_Str(Assigned(Instance),Instance.ClassName,'));
end;

 end;

Сохранение и загрузка перевода

Имеея описанные выше процедуры и функции мы без труда можем реализовать сохранение и загрузку информации.

Файлы для разных языков мы записываем в различные каталоги, поэтому реализуем функцию для выдачи пути к файлу перевода:

Function LangPath: String;
Begin
 Result:=NormalDir(NormalDir(ExtractFilePath(Application.ExeName))
 +'Langs'+User_Sets.LangInterface);
End;

В данной функции:

User_Sets.LangInterface – название текущего языка. Вместо этой переменной поставьте свою.

NormalDir – нормализует каталог. Эта функция взята из JVCL. Можно обойтись и без этой функции.

Формирование файла для перевода:

Procedure SaveLangTranslate(ObjInp: TObject{; LangInp: String});
Var TransTmp: String;
begin

 TransTmp:=GenSQLLang(ObjInp);
 

 if not DirectoryExists(LangPath)
 then ForceDirectories(LangPath);
 SaveStringToFile(TransTmp, LangPath{+Trim(LangInp)}+ObjInp.ClassName+'.xml');
End;

Загрузка перевода:

Procedure LoadLangTranslate(ObjInp: TObject{; LangInp: String});
Var TransTmp: String;
begin
 TransTmp:=LoadStringFromFile(LangPath{+Trim(LangInp)}+ObjInp.ClassName+'.xml');
 DecodeSQLLang(ObjInp,TransTmp);
end;

Перевод переменных, констант

От констант придется отказаться.

Следуем традиции и реализуем перевод с помощью xml. Для этого используем TXMLCollectionItem и TXMLCollection.

Элементы перевода (TXMLCollectionItem):

TCorp_Const_StringCollectionItem = class(TXMLCollectionItem)
private

 FIndexName: String;
FMessString: String;
 

public

 destructor Destroy; Override;
published
 property IndexName: String read FIndexName write FIndexName;
 property MessString: String read FMessString write FMessString;
end;

Коллекция элементов перевода (TXMLCollection):

TCorp_Const_StringCollection = class(TXMLCollection)

 private
 FLangInfo: String;

 public

 constructor Create;
destructor Destroy; Override;
Function AddNewItem: TCorp_Const_StringCollectionItem;
Procedure AddString(IndexNameInp, MessStringInp: String);
Procedure AddIfNotExist(IndexNameInp, MessStringInp: String);
function GetItemByIndex(index:integer): TCorp_Const_StringCollectionItem;
function GetItemByName(NameInp: String): TCorp_Const_StringCollectionItem;
function GetMessByName(NameInp: String): String;
 
 procedure Assign(Source: TPersistent); override;
published
 Property LangInfo: String read FLangInfo write FLangInfo;
End;

 …

 var Corp_Const_String: TCorp_Const_StringCollection;

 …

 constructor TCorp_Const_StringCollection.Create;
begin
 inherited Create(TCorp_Const_StringCollectionItem);
 FLangInfo:='Uk';
end;

 destructor TCorp_Const_StringCollection.Destroy;
begin
 Clear;
 inherited;
end;

 function TCorp_Const_StringCollection.AddNewItem: TCorp_Const_StringCollectionItem;
begin
 Result:=TCorp_Const_StringCollectionItem.Create(Self);
end;

 procedure TCorp_Const_StringCollection.AddString(IndexNameInp,
MessStringInp: String);
begin

 With AddNewItem Do
Begin
 IndexName:=IndexNameInp;
 MessString:=MessStringInp;
End;

 end;

 procedure TCorp_Const_StringCollection.AddIfNotExist(IndexNameInp,
MessStringInp: String);
Var ItemTmp: TCorp_Const_StringCollectionItem;
begin
ItemTmp:=GetItemByName(IndexNameInp);

 if not Assigned(ItemTmp) then
begin
 Corp_Const_String.AddString(IndexNameInp, MessStringInp);
end
else
begin

 ItemTmp.IndexName:=IndexNameInp;
 ItemTmp.MessString:=MessStringInp;

end;
 
end;

 function TCorp_Const_StringCollection.GetItemByIndex(
index: integer): TCorp_Const_StringCollectionItem;
begin
 result:=TCorp_Const_StringCollectionItem(items[index])
end;

 function TCorp_Const_StringCollection.GetItemByName(
NameInp: String): TCorp_Const_StringCollectionItem;
var i: integer;
begin

 result:=nil;

 for i:=0 to Count-1 Do
begin
if RusUpperCase(Trim(GetItemByIndex(i).IndexName))=RusUpperCase(Trim(NameInp))
then result:=GetItemByIndex(i);
 
end;

end;

 function TCorp_Const_StringCollection.GetMessByName(NameInp: String): String;
Var CorpConstTmp: TCorp_Const_StringCollectionItem;
begin

 CorpConstTmp:=GetItemByName(NameInp);

 if not Assigned(CorpConstTmp)
then Result:='{NameInp}
else Result:=CorpConstTmp.MessString;
 
end;

 procedure TCorp_Const_StringCollection.Assign(Source: TPersistent);
begin

 inherited Assign(Source); 

end;

Процедура для перевода всех ресурсов:

Procedure Gen_Corp_String;
Begin
 


if not Assigned(Corp_Const_String)
then Corp_Const_String:=TCorp_Const_StringCollection.Create;

 // Corp_Const_String.Clear;
Corp_Const_String.AddIfNotExist('1', 'Документ-источник не является счёт-фактурой');
Corp_Const_String.AddIfNotExist('2', 'По этому документу построен другой документ!');
Corp_Const_String.AddIfNotExist('3', 'Необходимо удалить вначале зависимый документ.');
Corp_Const_String.AddIfNotExist('4', 'Документа-источника нет!');
Corp_Const_String.AddIfNotExist('5', 'Зависимого документа нет!');
…

 End;

Демонстрационный проект

Исходные тексты демонстрационного проекта:
Translate.zip

Скомпилированный демонстрационный проект: Project1_sfx.zip

Рудюк С.А.

Получить ссылку на материал