В своей книге “Визуальное программирование” я подробно рассматривал вопросы локализации и интернационализации, настало время применить эти знания в новом проекте.

По умолчанию My Visual Database определяет локализацию операционной системы и подстраивается под неё. Но, во-первых MVDB поддерживает только два языка (русский и английский), во-вторых не всегда язык локализации ОС является желаемым языком для пользователя, а в-третьих в приложении имеются компоненты, созданные пользователем, а также всевозможные тестовые данные, добавленные скриптами. Поэтому для приложений, которые должны использоваться по всему миру, нужно предусмотреть удобный механизм локализации, который не требует переписывания кода самого приложения.

Для локализации будут использованы текстовые файлы, в которых хранятся пары ключ=значение. Но для большей гибкости будут использованы два типа ключей:

  • Статический (значение свойства форм или системный текстовый ресурс)
  • Динамический (пользовательский текстовый ресурс)

Статический ключ

Эти ключи обрабатываются единожды, при запуске программы. После того, как значение присвоено, пара удаляется из хранилища.

Статический ключ имеет три вида:

  • R.<Имя формы>.<Свойство>
  • R.<Имя формы>.<Имя компонента>.<Свойство>
  • T.<Идентификатор текстового ресурса>

Префикс R или T служит для обозначения динамического ключа. Для обработки ключей используется процедура Resource_L10App(). Процедура громоздкая, так как в процессе обработки приходится приводить компоненты к конкретному классу, чтобы назначить экземпляру класса нужные свойства.

procedure Resource_L10App;
// локализация всех форм приложения
// если имя ресурса составное R.<Форма>.<Компонент>.<Свойство>, то произвести замену
var
  i: integer;
  tmpWords: array of string;
  tmpForm: TForm;
  tmpComponent: TComponent;
  tmpValue: string;
  // вспомогательная процедура, делающая код более компактным
  procedure RE;
  begin
    RaiseException('Resource_L10Form() Не найдено свойство '+tmpWords[RESOURCE_I_FORM]+'.'+tmpWords[RESOURCE_I_COMPONENT]+'.'+tmpWords[RESOURCE_I_PROPERTY]);
  end;
begin
  for i:=StringRes.Lines.Count - 1 downto 0 do
  begin
    tmpWords := SplitString( StringRes.Lines.Names(i) , '.');
    // перевод слов и фраз, встроенных в MVDB
    if tmpWords[RESOURCE_I_PREFIX] = RESOURCE_TRANSLATE then
    begin
      tmpValue := StringRes.Lines.Strings(i);
      Delete(tmpValue,1,Pos('=',tmpValue));
      Translate( tmpWords[RESOURCE_I_IDENTIFIER],tmpValue );
      StringRes.Lines.Delete(i); // больше не нужен
    end
    else
    // перевод статических свойств
    if tmpWords[RESOURCE_I_PREFIX] = RESOURCE_PREFIX then
    begin
      if length(tmpWords)<3 then
        RaiseException('Resource_L10Form() неверный формат данных: '+StringRes.Lines.Strings(i) );
      //
      tmpValue := StringRes.Lines.Strings(i);
      Delete(tmpValue,1,Pos('=',tmpValue));
      //
      tmpForm := GetFormByName(tmpWords[RESOURCE_I_FORM]);
      if tmpForm = nil then
        RaiseException('Resource_L10Form() Не найдена форма '+tmpWords[RESOURCE_I_FORM]);
      //
      if length(tmpWords)=3 then
      begin // это форма
        case UpperCase( tmpWords[RESOURCE_I_COMPONENT] ) of
        'CAPTION': tmpForm.Caption := tmpValue;
        else RaiseException('Resource_L10Form() Не найдено свойство формы '+tmpWords[RESOURCE_I_FORM]+'.'+tmpWords[RESOURCE_I_COMPONENT]);
        end;
      end
      else // это компонент на форме
      begin
      FindC(tmpForm,tmpWords[RESOURCE_I_COMPONENT],tmpComponent,False);
      if tmpComponent = nil then
        RaiseException('Resource_L10Form() Не найден компонент '+tmpWords[RESOURCE_I_FORM]+'.'+tmpWords[RESOURCE_I_COMPONENT]);
      // нужно приводить к конкретному классу
      if (tmpComponent is TLabel) or (tmpComponent is TdbLabel) then
        case UpperCase( tmpWords[RESOURCE_I_PROPERTY] ) of
        'CAPTION': TLabel(tmpComponent).Caption := tmpValue;
        'HINT': TLabel(tmpComponent).Hint := tmpValue;
        else RE;
        end
      else
      if (tmpComponent is TdbCheckBox) or (tmpComponent is TCheckBox) then
        case UpperCase( tmpWords[RESOURCE_I_PROPERTY] ) of
        'CAPTION': TCheckBox(tmpComponent).Caption := tmpValue;
        'HINT': TCheckBox(tmpComponent).Hint := tmpValue;
        else RE;
        end
      else
      if  (tmpComponent is TTabSheet) or (tmpComponent is TdbTabSheet) then
        case UpperCase( tmpWords[RESOURCE_I_PROPERTY] ) of
        'CAPTION': TTabSheet(tmpComponent).Caption := tmpValue;
        'HINT': TTabSheet(tmpComponent).Hint := tmpValue;
        else RE;
        end
      else
      if tmpComponent is TGroupBox then
        case UpperCase( tmpWords[RESOURCE_I_PROPERTY] ) of
        'CAPTION': TGroupBox(tmpComponent).Caption := tmpValue;
        else RE;
        end
      else
      if tmpComponent is TRadioButton then
        case UpperCase( tmpWords[RESOURCE_I_PROPERTY] ) of
        'CAPTION': TRadioButton(tmpComponent).Caption := tmpValue;
        else RE;
        end
      else
      if (tmpComponent is TButton) or (tmpComponent is TdbButton) then
        case UpperCase( tmpWords[RESOURCE_I_PROPERTY] ) of
        'CAPTION': TButton(tmpComponent).Caption := tmpValue;
        'HINT': TButton(tmpComponent).Hint := tmpValue;
        else RE;
        end
      else
      if tmpComponent is TMenuItem then
        case UpperCase( tmpWords[RESOURCE_I_PROPERTY] ) of
        'CAPTION': TMenuItem(tmpComponent).Caption := tmpValue;
        else RE;
        end
      else
      if tmpComponent is TdbEdit then
        case UpperCase( tmpWords[RESOURCE_I_PROPERTY] ) of
        'HINT': TdbEdit(tmpComponent).Hint := tmpValue;
        'TEXTHINT': TdbEdit(tmpComponent).TextHint := tmpValue;
        else RE;
        end
      else
        RaiseException('Resource_L10Form() Неподдерживаемый класс '+tmpWords[RESOURCE_I_FORM]+'.'+tmpWords[RESOURCE_I_COMPONENT]+' - '+tmpComponent.ClassName);
      end;
      StringRes.Lines.Delete(i); // больше не нужен
    end;
  end;
end;Code language: Delphi (delphi)

Динамический ключ

Динамические ключи находятся в памяти всё время работы приложения, так как они могут понадобиться в любое время.

Для работы с динамическими ключами используется функция R(). Лаконичность её названия связана с тем, что её придется использовать во всех скриптах, которые программным образом задают свойства компонентам интерфейса.

function R(AName:string; ADefValue:string='???'):string;
// извлечение ресурсов
begin
  if (StringRes <> nil) and (StringRes.Lines.IndexOfName(AName) < 0) then
    Result := ADefValue
  else
    Result := StringRes.Lines.Values(AName);
end;
Code language: Delphi (delphi)

Обычно текстовое значение не хранится в коде, а размещается в константе:

const
  RESOURCE_CHANGE_LANGUAGE = 'Смена языка';
begin
  ShowMessage(RESOURCE_CHANGE_LANGUAGE);Code language: Delphi (delphi)

Для перевода такого участка кода на использование языкового ресурса потребуется небольшое и безопасное изменение:

ShowMessage(R('RESOURCE_CHANGE_LANGUAGE',RESOURCE_CHANGE_LANGUAGE));Code language: Delphi (delphi)

Безопасность изменения состоит в том, что если указанный ресурс не будет найден или система ресурсов не будет задействована, то функция R() вернет значение по умолчанию, находящееся в константе. Этот трюк также используется для создания файла локализации “по умолчанию” – он может быть пустым, так как все нужные значения будут браться из констант. Но при желании можно исправить надпись без изменения кода.

Если вы решили все текстовые ресурсы хранить в отдельном файле и не использовать строковые константы для хранения значений по умолчанию внутри кода, то допустим вызов функции R() без второго параметра.

ShowMessage(R('RESOURCE_CHANGE_LANGUAGE'));Code language: Delphi (delphi)

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

Инициализация ресурсов

При инициализации, которая происходит в процедуре Resourse_Init(), выполняется загрузка данных в компонент класса TdbMemo, который умеет корректно работать с файлами в формате UTF-8 c BOM.

Важно! Нужно использовать только указанный формат: UTF-8 c BOM
procedure Resource_Init();
// инициализация
var
  tmpFileList: array of string;
  i: integer;
  s: string;
  tmpDir: string;
begin
  tmpDir := ExtractFilePath(Application.ExeName)+RESOURCE_DIR;
  if DirectoryExists(tmpDir) then
  begin
    // языки - по количеству файлов. Каждый файл для своего языка
    Lаnguages := TStringList.Create;
    StringRes := TdbMemo.Create(MainForm);
    StringRes.Parent := MainForm;
    StringRes.Visible := False;
    StringRes.WordWrap := False;
    tmpFileList := SplitString( GetFilesList(tmpDir,'*'+RESOURCE_EXT, False), chr(13) );
    for i:=0 to Length(tmpFileList) -1 do
    begin
      s := Trim(ExtractFileName(tmpFileList[i]));
      if s<>'' then
      begin
        delete(s,length(s)-3,4);
        Lаnguages.Add(s);
      end;
    end;
    // текущий язык - прочитать из настройки
    currentLаnguage := IniFile_Read( RESOURCE_INI_SECTION, RESOURCE_INI_CUR_LANG, '' );
    i := Lаnguages.IndexOf(currentLаnguage);
    if i = -1 then
      i := 0;
    if i = -1 then
      RaiseException('Resurce_Init() - не найден язык: '+currentLаnguage)
    else
    begin
      StringRes.Lines.LoadFromFile(tmpDir + '\'+ Lаnguages.Strings(i) + RESOURCE_EXT);
    end;
    // статическая локализация
    Resource_L10App;
  end;
end;
Code language: PHP (php)

Пример файла с ресурсами:

APP_ABOUT_CAPTION=О программе
APP_CONFIRM_RESTART=Для применения изменений требуется перезапуск программы. Выполнить сейчас?
APP_COPYRIGHT=2023 Константин Паньков
APP_NAME=Руководство разработчика
APP_UPDATE_DATE=Дата обновления базы данных:
APP_VERSION_LABEL=Версия
DTF_CLASSEVENT_CAPTIONS=Имя,Описание
DTF_CLASSTYPE_TREE_CAPTIONS=Имя
DTF_CLASSTYPE_TYPELIST_CAPTIONS=Имя,Описание
DTF_FUNCPROCPARAM_FUNCTION_CAPTIONS=#,Имя,Тип,*,Описание
DTF_FUNCPROCPARAM_METHOD_CAPTIONS=#,Имя,Описание
DTF_PROJECT_TREE_CAPTIONS=Имя,Путь,Статус,Описание
DTF_TASK_TREE_CAPTIONS=Имя
DTF_TYPECONST_CAPTIONS=Имя,Описание
R.efmClassEvent.Caption=Событие
R.efmClassEvent.btnCancel.Caption=Отмена
R.efmClassEvent.btnNew_Example.Hint=Добавить...
R.efmClassEvent.btnSave.Caption=Сохранить
R.efmClassEvent.labName.Caption=Имя
R.efmClassEvent.labProcedure.Caption=Процедура
R.efmClassType.Caption=Класс
R.efmClassType.btnCancel.Caption=Отмена
R.efmClassType.btnNew_Example.Hint=Добавить...
Code language: SQL (Structured Query Language) (sql)

Переключение языка

Для смены языка нам понадобится пункт меню. Для его создания служит процедура Resource_CreateMenu(), а в обработчике нажатия вызывается процедура установки выбранного языка Resource_SetLanguage()

procedure Resource_CreateMenu( AForm:TForm );
// создание пункта меню "Язык"
var
  i: integer;
  tmpItem: TMenuItem;
  tmpTopItem: TMenuItem;
begin
  // создадим пункт меню верхнего уровня
  tmpTopItem := TMenuItem.Create( AForm );
  tmpTopItem.Name := 'mniLanguage';
  tmpTopItem.Caption := R('RESOURCE_MENU_LANGUAGE',RESOURCE_MENU_LANGUAGE);
  AForm.Menu.Items.Insert(1,tmpTopItem);
  // добавим пункты меню для смены языка
  for i := 0 to Lаnguages.Count - 1 do
  begin
    tmpItem := TMenuItem.Create( AForm );
    tmpItem.Name := 'mniSetLanguage_'+IntToStr(i);
    tmpItem.Caption := Lаnguages.Strings(i);
    tmpItem.OnClick := @Resource_MenuItem_OnClick;
    tmpItem.RadioItem := True; // выделение точкой, зависимые переключатели
    tmpItem.GroupIndex := 1; // зависимые переключатели
    tmpItem.Autocheck := True; // автоматическое переключение при клике
    // выделить текущий язык
    if Lаnguages.Strings(i) = currentLаnguage then
      tmpItem.Checked := True;
    tmpTopItem.Insert(i,tmpItem);
  end;
end;

procedure Resource_MenuItem_OnClick (Sender: TObject; );
// Клик по пункту меню выбора языка
begin
  // удаляем спецсимволы, которые добавились автоматически
  Resource_SetLanguage( ReplaceStr(TMenuItem(Sender).Caption,'&','') );
end;Code language: PHP (php)

Из-за наличия динамически изменяемых текстовых ресурсов смена языка требует перезагрузки приложения. Перезагрузка может понадобиться и в других случаях, поэтому разумно оформить для неё отдельную процедуру Restart(), которая отображает форму подтверждения перед выполнением перезагрузки.

procedure Resource_SetLanguage(AName:string);
// установка языка
// изменения вступят в силу после перезагрузки
begin
  IniFile_Write( RESOURCE_INI_SECTION, RESOURCE_INI_CUR_LANG, AName );
  Restart(True, R('RESOURCE_CHANGE_LANGUAGE',RESOURCE_CHANGE_LANGUAGE))
end;

procedure Restart(AConfirm:boolean = False; AReason:string);
begin
  // предупреждение
  if (not AConfirm) or (MessageBox( R('APP_CONFIRM_RESTART',APP_CONFIRM_RESTART) ,AReason,MB_OKCANCEL ) = mrOK) then
  begin
    frmMain.Close; // закрытие текущего приложения. На самом деле эта команда только создаёт сообщение, фактически закрытие произойдет после завершения текущей процедуры.
    OpenFile( Application.ExeName ); // запуск приложения
  end;
end;Code language: Delphi (delphi)

Известные проблемы

На этом локализация не заканчивается. Есть небольшой список компонентов и свойств с нетривиальным способом доступа к ним, который также необходимо обработать. В основном это касается заголовков таблиц и выпадающих списков на служебных формах. Также необходимо выполнить локализацию контекстных меню для таблиц, деревьев и других компонентов. Самая сложная операция – локализация перевода сообщения об ошибке аутентификации на форме ввода пароля и логина, которая потребует замены стандартной кнопки. Так что тема остается открытой.

Бонус

В приложении активно используются динамические формы из модуля DTF.pas. Создание этих форм осуществлялось в процедуре UserApp_InitForm(), но ввиду однородности строковых параметров я решил добавить процедуру DTF_CreateForms(), которая проделывает всю работу по созданию форм на основании текстового файла dforms.ini, а заодно использует только что созданную систему локализации.


procedure DTF_CreateForms;
// создание динамических форм по списку, находящемуся в файле dforms.ini
var
  tmpIniFile: TIniFile;
  tmpFormList:TStringList;
  i:integer;
  tmpForm: TForm;
  tmpSName: string;

  function S(AName:string):string;
  begin
    Result := tmpIniFile.ReadString( tmpFormList.Strings(i), AName, '' );
  end;

begin
  tmpIniFile := TIniFile.Create( ExtractFilePath(Application.ExeName)+'dforms.ini' );
  tmpFormList := TStringList.Create;
  tmpIniFile.ReadSections(tmpFormList);
  for i:=0 to tmpFormList.count - 1 do
  begin
    tmpSName := 'DTF_'+UpperCase(tmpFormList.Strings(i))+'_CAPTIONS';
    tmpForm := DTF_Create(tmpFormList.Strings(i),S('table'),S('fields'), R( tmpSName,S('captions')),S('sort'),S('parentField'),S('filter'),S('isDetail')='True');
    Form_ShowOnWinControl( tmpForm, TWinControl( FindCF( S('parentControl') ) ) );
  end;
  tmpFormList.Free;
  tmpIniFile.Free;
end;Code language: Delphi (delphi)

Структура файла dforms.ini достаточно простая, чтобы при необходимости добавлять новые формы прямо в текстовом редакторе.

[Keyword]
table=keyword
fields=keyword.name,keyword.Description
captions=Название,Описание
sort=keyword.name
parentControl=frmMain.tshKeyword
[Operator_Tree]
table=operator
fields=operator.name,operator.Description
captions= Название, Описание
sort=ParentID,name
parentField=parentID
parentControl=frmMain.tshOperator
[ClassType_TypeList]
table=classType
fields=classType.name,classType.Description
captions= Название, Описание
sort=classType.name
filter=isType = 1
parentControl=frmMain.panType
Code language: SQL (Structured Query Language) (sql)

А в копилку полезных функций добавилась FindCF(), которая умеет отыскивать компоненты на форме по их полному пути <Имя формы>.<Имя компонента>

function FindCF(AName:string): TComponent;
// находит компонент по полному имени.
var
  tmpForm:TForm;
  tmpWords: array of string;
begin
  tmpWords := SplitString(AName,'.');
  if Length(tmpWords) < 2 then
    RaiseException('FindCF('+AName+') неверный аргумент');
  tmpForm := GetFormByName( tmpWords[0] );
  if tmpForm = nil then
    RaiseException('FindCF('+AName+') Не найдена форма '+tmpWords[0]);
  Result := tmpForm.FindComponent(tmpWords[1]);
  if Result = nil then
    RaiseException('FindCF('+AName+') Не найден компонент '+tmpWords[1]);
end;Code language: Delphi (delphi)

Ссылки

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *