Вы не авторизированы! Логин:  Пароль:  Запомнить:    Зарегистрироваться
Забыл пароль
 
 
 

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

SVD programming - Программирование Delphi, HTML, PHP, CGI. Обзоры софта, ReactOS и многое другое...
 
Главная - Новости - Публикации - Файлы - Ссылки - Форум Обратная связь
 


Друзья сайта ::

Сайтом управляют ::

Друзья сайта ::
Delphi » Перевод в Delphi-приложениях
Автор: Рудюк С.А. / Дата: 14:48 02.03.2006
Комментарии: Комментарии (0)
Рейтинг статьи: 0
Стандартный способ локализации приложений

С помощью ресурсов на нужном языке (с помощью меню 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;

Источник: http://nerusoft.com
Автор : Рудюк С.А.
Комментарии: Комментарии (0)

Внимание!

Друзья сайта
Голосование ::
Случайные статьи ::
Добавления в форуме ::
Новые комментарии ::
Пользователи on-line ::
0 пользователь, 38 гостей
 
Страница создана за 0.105 секунд

SQL общее время: 0.013 секунд
SQL запросов всего: 14
Администрация сайта не несет ответственности за содержание рекламных материалов, а так же за информацию размещаемой посетителями. При использовании материалов сайта ссылка на svdpro.info обязательна.

Powered by LDU 802

Рейтинг@Mail.ru
Copyright © 2005 - 2011 «SVD Programming»
Версия сайта для коммуникаторов
Обратная связь - Карта сайта