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

Источник: delphiplus

Введение

Реализовать перевод в приложениях 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)+'<' + PPropInfo(Props.Items[i]).Name + '>');
        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]
  MP @@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;

Ссылки по теме

Файлы для загрузки