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

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

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

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

Код:

Загрузка в приложение из 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)

Внимание!

Администрация сайта не предоставляет справку и консультации по размещённой информации.

Друзья сайта