Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Поддержка многоязычного интерфейса

01.01.2007

Поддержка многоязычного интерфейса.

Подчас бывает актуально встроить в разрабатываемую программу поддержку нескольких языков. Существует множество средств и компонентов для осуществления подобных задач. У всех этих средств один недостаток - они слишком сложны и тяжеловесны. Предлагаем рассмотреть, как можно обеспечить поддержку многоязычности используя более простой и прозрачный метод.
 
Первое, что нужно выяснить - это язык, на котором разрабатывать интерфейс первоначально. Есть веские причины за то, чтобы использовать для этого именно тот язык, на котором написана эта статья. Дело в том, что русский язык менее лаконичен других европейских языков. При переводе на английский или немецкий 90% фраз будет компактнее и интерфейс вашей программы искажен не будет.
 

Для поддержки нескольких языков предлагается следующий простой подход. Интерфейс оформляется на родном языке - русском. Для всех остальных языков составляется словарь в виде:

Строка на языке 1=Строка на языке 2

Строка на языке 2=Строка на языке 2

...

Например:

Файл=File

Выход=Exit

Отмена=Cancel

И так для всех ресурсов приложения. Словарь поместим в отдельный текстовый файл.
 

Далее, нам необходимо для каждого текстового свойства любого компонента приложения поискать перевод в нашем словаре. Здесь не обойтись без Delphi RTTI. Через Component.ClassInfo получим ссылку на информацию типа, а затем GetTypeData(TypeInf) даст нам указатель на структуру с его описанием.

  TypeInf := Component.ClassInfo; 
 
AName := TypeInf^.Name;
 
TypeData := GetTypeData(TypeInf);
 
NumProps := TypeData^.PropCount;

 

Далее проходимся по всем свойствам данного (классового) типа.

GetMem(PropList, NumProps*sizeof(pointer)); 
 
 
try
   
GetPropInfos(TypeInf, PropList);
 
   
for i := 0 to NumProps-1 do
   
begin
     
PropName := PropList^[i]^.Name;
 
     
PropTypeInf := PropList^[i]^.PropType^;
     
PropInfo := PropList^[i];
 
 
     
case PropTypeInf^.Kind of
        tkString
, tkLString:  //... это то, что нам нужно
       
if PropName <> 'Name' then { Переводить свойство Name не следует }
       
begin
         
{ Получение значения свойства и поиск перевода в словаре }
         
StringPropValue := GetStrProp( Component, PropInfo );
         
SetStrProp( Component, PropInfo, TranslateString(StringPropValue) );
       
end;
...
...

 
Отдельный случай - списки TStrings и коллекции типа TTReeNodes и TListItems. Их придется обработать персонально.

 

 tkClass: 
       
begin
         
PropObject := GetObjectProp(Component, PropInfo{, TPersistent});
 
         
if Assigned(PropObject)then
         
begin
           
{ Для дочерних свойств-классов вызов просмотра свойств }
           
if (PropObject is TPersistent) then
             
UpdateComponent(PropObject as TPersistent);
 
           
{ Индивидуальный подход к некоторым классам }
           
if (PropObject is TStrings) then
           
begin
             
for j := 0 to (PropObject as TStrings).Count-1 do
               
TStrings(PropObject)[j] := TranslateString(TStrings(PropObject)[j]);
           
end;
           
if (PropObject is TTreeNodes) then
           
begin
             
for j := 0 to (PropObject as TTreeNodes).Count-1 do
               
TTreeNodes(PropObject).Item[j].Text :=
                 
TranslateString(TTreeNodes(PropObject).Item[j].Text);
           
end;
           
if (PropObject is TListItems) then
           
begin
             
for j := 0 to (PropObject as TListItems).Count-1 do
               
TListItems(PropObject).Item[j].Caption
                 
:= TranslateString(TListItems(PropObject).Item[j].Caption);
           
end;
           
{ Здесь можно добавить обработку остальных классов }
         
end;
 
       
end;

 

Объединяя все написанное, получим компонент для перевода строковых ресурсов.

{
Globus Delphi VCL Extensions Library
Freeware
Copyright (c) 1998,2001 Chudin A.V, chudin@yandex.ru
 
===================================================================
 glLanguageLoader
Unit 04.2001             component TglLanguageLoader
 
===================================================================
 
Load new string resources from file to components
 
 
Словарь в виде текста вида:
 
Строка на языке 1=Строка на языке 2
 
...
 
Строка на языке 1=Строка на языке 2
 
===================================================================
}
unit glLanguageLoader
;
 
interface
{$I glDEF.INC}
uses
 
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, comctrls, grids;
 
type
 
TLanguageLoaderOptions = set of (lofTrimSpaces);
 
{опция удаления начальных и завершающих пробелов}
 
 
TglLanguageLoader = class(TComponent)
 
private
    sl
: TStringList;
   
FOptions: TLanguageLoaderOptions;
   
function TranslateString(sString: string): string;
 
protected
    procedure
UpdateComponent(Component: TPersistent); virtual;
 
public
    procedure
LoadLanguage(Component: TComponent; FileName: string); {main function}
  published
    property
Options: TLanguageLoaderOptions read FOptions write FOptions;
 
end;
 
procedure
LoadLanguage(Component: TComponent; FileName: string; Options: TLanguageLoaderOptions);
 
procedure
Register;
 
implementation
uses
TypInfo, dsgnintf;
 
procedure
Register;
begin
 
RegisterComponents('Gl Components', [TglLanguageLoader]);
end;
 
{Ф-ия для загрузки словаря без предварительного создания компонента}
procedure
LoadLanguage(Component: TComponent; FileName: string; Options: TLanguageLoaderOptions);
var
 
LanguageLoader: TglLanguageLoader;
begin
 
LanguageLoader := TglLanguageLoader.Create(nil);
 
try
     
LanguageLoader.LoadLanguage(Component, FileName);
 
finally
   
LanguageLoader.Free;
 
end;
end;
 
{ TglLanguageLoader }
 
{  Загрузка словаря, обход указанного компонента и  }
{  всех его дочерних компонентов                    }
procedure
TglLanguageLoader.LoadLanguage(Component: TComponent; FileName: string);
  procedure
UpdateAllComponents(Component: TComponent);
 
var i: integer;
 
begin
   
{ обработка своцств компонента }
   
UpdateComponent(Component);
   
for i := 0 to Component.ComponentCount-1 do
     
UpdateAllComponents(Component.Components[i]);
 
end;
begin
  sl
:= TStringList.Create;
 
try
   
{ Загрузка словаря из заданного файла }
    sl
.LoadFromFile(FileName);
    sl
.Sorted := true;
   
UpdateAllComponents(Component);
 
finally
    sl
.Free;
 
end;
end;
 
{ Проход по всем свойствам компонента                        }
{ Для всех строковых свойств - загрузка перевода из сооваря  }
procedure
TglLanguageLoader.UpdateComponent(Component: TPersistent);
var
 
PropInfo: PPropInfo;
 
TypeInf, PropTypeInf: PTypeInfo;
 
TypeData: PTypeData;
  i
, j: integer;
 
AName, PropName, StringPropValue: string;
 
PropList: PPropList;
 
NumProps: word;
 
PropObject: TObject;
begin
 
{ Playing with RTTI }
 
TypeInf := Component.ClassInfo;
 
AName := TypeInf^.Name;
 
TypeData := GetTypeData(TypeInf);
 
NumProps := TypeData^.PropCount;
 
 
GetMem(PropList, NumProps*sizeof(pointer));
 
 
try
   
GetPropInfos(TypeInf, PropList);
 
   
for i := 0 to NumProps-1 do
   
begin
     
PropName := PropList^[i]^.Name;
 
     
PropTypeInf := PropList^[i]^.PropType^;
     
PropInfo := PropList^[i];
 
 
     
case PropTypeInf^.Kind of
        tkString
, tkLString:
       
if PropName <> 'Name' then { Переводить свойство Name не следует }
       
begin
         
{ Получение значения свойства и поиск перевода в словаре }
         
StringPropValue := GetStrProp( Component, PropInfo );
         
SetStrProp( Component, PropInfo, TranslateString(StringPropValue) );
       
end;
        tkClass
:
       
begin
         
PropObject := GetObjectProp(Component, PropInfo{, TPersistent});
 
         
if Assigned(PropObject)then
         
begin
           
{ Для дочерних свойств-классов вызов просмотра свойств }
           
if (PropObject is TPersistent) then
             
UpdateComponent(PropObject as TPersistent);
 
           
{ Индивидуальный подход к некоторым классам }
           
if (PropObject is TStrings) then
           
begin
             
for j := 0 to (PropObject as TStrings).Count-1 do
               
TStrings(PropObject)[j] := TranslateString(TStrings(PropObject)[j]);
           
end;
           
if (PropObject is TTreeNodes) then
           
begin
             
for j := 0 to (PropObject as TTreeNodes).Count-1 do
               
TTreeNodes(PropObject).Item[j].Text :=
                 
TranslateString(TTreeNodes(PropObject).Item[j].Text);
           
end;
           
if (PropObject is TListItems) then
           
begin
             
for j := 0 to (PropObject as TListItems).Count-1 do
               
TListItems(PropObject).Item[j].Caption :=
                 
TranslateString(TListItems(PropObject).Item[j].Caption);
           
end;
           
{ Здесь можно добавить обработку остальных классов }
         
end;
 
       
end;
 
     
end;
   
end;
 
finally
   
FreeMem(PropList, NumProps*sizeof(pointer));
 
end;
end;
 
{ Поиск перевода для заданной строки в словаре }
function TglLanguageLoader.TranslateString(sString: string): string;
begin
 
if lofTrimSpaces in Options then sString := trim(sString);
 
if sString = '' then
 
begin
   
Result := '';
   
exit;
 
end;
 
if sl.IndexOfName(sString) <> -1 then Result := sl.Values[sString] else Result := sString;
end;
 
 
end.
составление статьи: Андрей Чудин, ЦПР ТД Библио-Глобус.

Взято из http://delphi.chertenok.ru