Реализовать перевод в приложениях 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;
Рудюк С.А.