langmgr.pas

delphi本地数据库引擎

unit LangMgr;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, TypInfo, TinyDB, IniFiles;

const
  //LCID Consts
  LangChinesePR = (SUBLANG_CHINESE_SIMPLIFIED shl 10) or LANG_CHINESE;
  LangChineseTW = (SUBLANG_CHINESE_TRADITIONAL shl 10) or LANG_CHINESE;
  LangEnglish = (SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH;
  LangFrench = (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
  LangGerman = (SUBLANG_GERMAN shl 10) or LANG_GERMAN;

  SLangMgrDbName = 'LangMgrDbName';

type
  PLangItem = ^TLangItem;
  TLangItem = record
    LangName: string;
    FileName: string;
  end;
  TLangItems = array of TLangItem;

  TLangFontData = record
    Name: string;
    Size: Integer;
    Charset: TFontCharset;
  end;

{ TLangMgrBase }

  TLangMgrBase = class(TObject)
  protected
    FLangItems: TLangItems;
    FLangFontData: TLangFontData;
    FFontInited: Boolean;
    FDefaultLangIndex: Integer;       //Default language
    FCurrentLangIndex: Integer;       //Current language

    function GetLangItem(Index: Integer): TLangItem;
    function GetLangCount: Integer;
    function GetFormString(Name: string; var Value: string): Boolean; virtual; abstract;
    function GetMiscString(Name: string; var Value: string): Boolean; virtual; abstract;
    function GetFontData(var FontData: TLangFontData): Boolean; virtual; abstract;
    function InternalInitLang(Index: Integer): Boolean; virtual;
  public
    function IsLangFile(FileName: string): Boolean; virtual; abstract;
    function GetLangNameFromFileName(FileName: string): string; virtual; abstract;
    function GetDefaultLangIndex(LangItems: TLangItems): Integer; virtual;
    function GetLangFileList(List: TStrings; Path: string): Integer;
    function IndexOfLangName(LangName: string): Integer;
    //Misc functions
    class function GetLangFileExt(Locale: LCID): string;
    class function GetDefaultLangFileExt: string;
  public
    constructor Create;
    destructor Destroy; override;
    function InitPath(Path: string): Integer; virtual;
    function InitLang(Index: Integer): Boolean; virtual;

    procedure Trans(Form: TForm); overload;
    function Trans(Src: string): string; overload;
    function Trans(Src: string; Args: array of const): string; overload;

    property Items[Index: Integer]: TLangItem read GetLangItem;
    property Count: Integer read GetLangCount;
    property DefaultLangIndex: Integer read FDefaultLangIndex;
    property CurrentLangIndex: Integer read FCurrentLangIndex;
    property FontData: TLangFontData read FLangFontData;
  end;

{ TTDBLangMgr }

  TTDBLangMgr = class(TLangMgrBase)
  private
    FTinyDatabase: TTinyDatabase;
    FFormTable: TTinyTable;
    FMiscTable: TTinyTable;
    FDBStream: TMemoryStream;
  protected
    function GetFormString(Name: string; var Value: string): Boolean; override;
    function GetMiscString(Name: string; var Value: string): Boolean; override;
    function GetFontData(var FontData: TLangFontData): Boolean; override;
    function InternalInitLang(Index: Integer): Boolean; override;
  public
    function IsLangFile(FileName: string): Boolean; override;
    function GetLangNameFromFileName(FileName: string): string; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

{ TIniLangMgr }

  TIniLangMgr = class(TLangMgrBase)
  private
    FIniFile: TIniFile;
  protected
    function GetFormString(Name: string; var Value: string): Boolean; override;
    function GetMiscString(Name: string; var Value: string): Boolean; override;
    function GetFontData(var FontData: TLangFontData): Boolean; override;
    function InternalInitLang(Index: Integer): Boolean; override;
  public
    function IsLangFile(FileName: string): Boolean; override;
    function GetLangNameFromFileName(FileName: string): string; override;
  public
    constructor Create;
    destructor Destroy; override;
  end;

var
  AppLangMgr: TLangMgrBase;

implementation

{ TLangMgrBase }

constructor TLangMgrBase.Create;
begin
  inherited;
  FDefaultLangIndex := -1;
  FCurrentLangIndex := -1;
end;

destructor TLangMgrBase.Destroy;
begin
  inherited;
end;

function TLangMgrBase.GetLangItem(Index: Integer): TLangItem;
begin
  Result := FLangItems[Index];
end;

function TLangMgrBase.GetLangCount: Integer;
begin
  Result := Length(FLangItems);
end;

function TLangMgrBase.InternalInitLang(Index: Integer): Boolean;
begin
  Result := True;
end;

function TLangMgrBase.GetDefaultLangIndex(LangItems: TLangItems): Integer;
var
  I: Integer;
  DefaultExt: string;
begin
  Result := -1;
  DefaultExt := GetDefaultLangFileExt;
  for I := 0 to Length(LangItems) - 1 do
  begin
    if CompareText(ExtractFileExt(LangItems[I].FileName), DefaultExt) = 0 then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function TLangMgrBase.GetLangFileList(List: TStrings; Path: string): Integer;
var
  Sr: TSearchRec;
  FileName: string;
begin
  if Copy(Path, Length(Path), 1) <> '\' then
    Path := Path + '\';
  List.BeginUpdate;
  try
    List.Clear;
    if FindFirst(Path + '*.*', faAnyFile, Sr) = 0 then
    begin
      repeat
        FileName := Path + Sr.Name;
        if IsLangFile(FileName) then List.Add(FileName);
      until FindNext(Sr) <> 0;
      FindClose(Sr);
    end;
  finally
    List.EndUpdate;
  end;
  Result := List.Count;
end;

function TLangMgrBase.IndexOfLangName(LangName: string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to Length(FLangItems) - 1 do
  begin
    if CompareText(LangName, FLangItems[I].LangName) = 0 then
    begin
      Result := I;
      Break;
    end;
  end;
end;

//---------------------------------------------------------------------------
//Return the file ext name by system default locale identifier.
//---------------------------------------------------------------------------
class function TLangMgrBase.GetDefaultLangFileExt: string;
begin
  Result := GetLangFileExt(SysLocale.DefaultLCID);
end;

//---------------------------------------------------------------------------
//Return the file ext name by a locale identifier(LCID).
//e.g. ".chs"
//---------------------------------------------------------------------------
class function TLangMgrBase.GetLangFileExt(Locale: LCID): string;
var
  LocaleName: array[0..4] of Char;
begin
  GetLocaleInfo(Locale, LOCALE_SABBREVLANGNAME, LocaleName, SizeOf(LocaleName));
  case Locale of
    LangChineseTW:  Result := 'cht';
    else  Result := LocaleName;
  end;
  Result := '.' + Result;
end;

function TLangMgrBase.InitPath(Path: string): Integer;
var
  FileList: TStrings;
  I: Integer;
begin
  FileList := TStringList.Create;
  try
    GetLangFileList(FileList, Path);
    SetLength(FLangItems, FileList.Count);
    for I := 0 to FileList.Count - 1 do
    begin
      FLangItems[I].FileName := FileList[I];
      FLangItems[I].LangName := GetLangNameFromFileName(FileList[I]);
    end;
    FDefaultLangIndex := GetDefaultLangIndex(FLangItems);
  finally
    Result := FileList.Count;
    FileList.Free;
  end;
end;

function TLangMgrBase.InitLang(Index: Integer): Boolean;
begin
  if (Index < 0) or (Index >= Count) then
  begin
    Result := False;
    Exit;
  end;
  FCurrentLangIndex := Index;
  Result := InternalInitLang(Index);
  if not Result then Exit;
  FFontInited := GetFontData(FLangFontData);
end;

procedure TLangMgrBase.Trans(Form: TForm);
const
  PropNames: array[0..2] of PChar = ('Caption', 'Text', 'Hint');
var
  I, J: Integer;
  Compo: TComponent;
  PropInfoPtr: PPropInfo;
  FullName, PropName, PropOldValue, PropNewValue: string;
begin
  for I := -1 to Form.ComponentCount - 1 do
  begin
    if I = -1 then Compo := Form
    else Compo := Form.Components[I];
    for J := Low(PropNames) to High(PropNames) do
    begin
      PropName := PropNames[J];
      PropInfoPtr := GetPropInfo(Compo, PropName);
      if PropInfoPtr <> nil then
        if PropInfoPtr^.PropType^.Kind = tkLString then
        begin
          PropOldValue := GetStrProp(Compo, PropInfoPtr);
          if ((PropOldValue <> '') and (PropOldValue <> '-')) then
          begin
            //FullName := Form.Name + '.';
            FullName := Form.ClassName + '.';
            if I <> -1 then FullName := FullName + Compo.Name + '.';
            FullName := FullName + PropName;
            if GetFormString(FullName, PropNewValue) then
              SetStrProp(Compo, PropName, PropNewValue);
          end;