Перевод в Delphi-приложениях

Введение

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

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

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

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

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

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

Недостатки:

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

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

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

К преимуществам данного способа можно отнести:

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

К недостаткам данного способа можно отнести:

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

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

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

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

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

Для локализации, воспользуемся некоторыми из функций проекта XMLWorks: http://r.codenet.ru/?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 (ZIP, 59Kb)