lang.pas

Delphi多语言界面设置控件

unit Lang;

interface

uses
  Menus, DBCtrls, DB, ADODB, DBGrids, ComCtrls, Grids, CheckLst, ExtCtrls, Buttons,
  StdCtrls, Dialogs, Windows, Messages, SysUtils, Classes, Forms, Inifiles, Controls,
  Graphics;

type
  TOnProgressEvent = procedure(Sender: TObject; TotalSize, Readed: Integer) of object;
  TOnDoneEvent = procedure(Sender: TObject) of object;
  TLang = class(TComponent)
  private
    FVersion, aVersion, FLangDir, FDefLang, FPageLayout, FFontName, aAuthor, FAuthor: string;
    FFontSize: Integer;
    InI: TiniFile;
    MyForm: TForm;
    FProgress: TOnProgressEvent;
    FOnDone: TOnDoneEvent;
    function ReadInI(const Section, Ident, Default: string): string;
    procedure WriteInI(const Section, Ident, Value: string);
    procedure UpdateProgress(TotalSize, Readed: Integer);
    procedure SetCaption(SelfControl: TLabel); overload;
    procedure SetCaption(SelfControl: TRadioGroup); overload;
    procedure SetCaption(SelfControl: TListBox); overload;
    procedure SetCaption(SelfControl: TComboBox); overload;
    procedure SetCaption(SelfControl: TStringGrid); overload;
    procedure SetCaption(SelfControl: TStatusBar); overload;
    procedure SetCaption(SelfControl: TLabeledEdit); overload;
    procedure SetCaption(SelfControl: TListView); overload;
    procedure SetCaption(SelfControl: TTabControl); overload;
    procedure SetCaption(SelfControl: TPageControl); overload;
    procedure SetCaption(SelfControl: THeaderControl); overload;
    procedure SetCaption(SelfControl: TToolBar); overload;
    procedure SetCaption(SelfControl: TADOConnection); overload;
    procedure SetCaption(SelfControl: TADOCommand); overload;
    procedure SetCaption(SelfControl: TADODataSet); overload;
    procedure SetCaption(SelfControl: TADOQuery); overload;
    procedure SetCaption(SelfControl: TADOTable); overload;
    procedure SetCaption(SelfControl: TDBGrid); overload;
    procedure SetCaption(SelfControl: TMainMenu); overload;
    procedure SetCaption(SelfControl: TMenuItem); overload;

    { Private declarations }
  protected
    { Protected declarations }
  public
    TStr: TStrings;
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetLang(LangFile: string);
  published
    { Published declarations }
    property Version: string read FVersion write aVersion;
    property LangDir: string read FLangDir write FLangDir;
    property DefLang: string read FDefLang write FDefLang;
    property PageLayout: string read FPageLayout write FPageLayout;
    property FontName: string read FFontName write FFontName;
    property FontSize: Integer read FFontSize write FFontSize;
    property OnProgress: TOnProgressEvent read FProgress write FProgress;
    property OnDone: TOnDoneEvent read FOnDone write FOnDone;
    property Author: string read FAuthor write aAuthor;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('PPSSoft', [TLang]);
end;

function MkDirectory(DirStr: string; IsFile: Boolean): Boolean;
var T1: string;
begin
  Result := True;
  if IsFile then
    T1 := ExtractFilePath(DirStr)
  else
    T1 := DirStr;
  if not DirectoryExists(T1) then begin
    CreateDir(T1);
  end;
  if not DirectoryExists(T1) then begin
    Result := False;
  end;
end;

function GetNum(T: Integer): string;
var T1: string;
  I: Integer;
begin
  T1 := IntToStr(T);
  for I := 6 - length(T1) downto 1 do begin
    T1 := '0' + T1
  end;
  Result := T1;
end;

constructor TLang.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  TStr := TStringlist.Create;
  FVersion := '0.1';
  FAuthor := 'Pigeon(www.vifo.cn)';
  FDefLang := 'Chinese Simplified(中文简体)';
  FLangDir := 'Language';
  MyForm := TForm(aOwner);
end;

destructor TLang.Destroy;
begin
  TStr.Free;
  inherited;
end;

procedure TLang.UpdateProgress(TotalSize, Readed: Integer);
begin
  if Assigned(FProgress) then FProgress(self, TotalSize, Readed);
end;
procedure TLang.SetLang(LangFile: string);
var T1: string;
  I, J: Integer;
begin
  if LangFile = '' then LangFile := 'Default';
  if FLangDir = '' then FLangDir := 'Language';
  if PageLayout = '' then PageLayout := MyForm.Name;
  MkDirectory(FLangDir, False);
  if not FileExists(FLangDir + '\' + LangFile + '.InI') then LangFile := 'Default';
  InI := TiniFile.Create(FLangDir + '\' + LangFile + '.ini');
  WriteInI('INFO', 'Language', FDefLang);
  T1 := ReadInI('INFO', 'Font', '');
  if T1 = '' then WriteInI('INFO', 'Font', FFontName) else FFontName := T1;
  T1 := ReadInI('INFO', 'FontSize', '');
  if T1 = '' then WriteInI('INFO', 'FontSize', IntToStr(FFontSize)) else FFontSize := StrToInt(T1);
  T1 := ReadInI(PageLayout, '000000', '');
  if T1 = '' then WriteInI(PageLayout, '000000', MyForm.Caption) else MyForm.Caption := T1;
  J := StrToInt(ReadInI(PageLayout + '_Str', 'Count', '0'));
  TStr.Clear;
  for I := 0 to J - 1 do begin
    TStr.Add(ReadInI(PageLayout + '_Str', 'Str_' + IntToStr(I), ''));
  end;

  for I := 0 to MyForm.ComponentCount - 1 do
  begin
    UpdateProgress(MyForm.ComponentCount, I);
    if MyForm.Components[I].Tag <> 0 then begin
      if ((MyForm.Components[I] is TLabel)
        or (MyForm.Components[I] is TButton)
        or (MyForm.Components[I] is TCheckBox)
        or (MyForm.Components[I] is TDBCheckBox)
        or (MyForm.Components[I] is TRadioButton)
        or (MyForm.Components[I] is TBitBtn)
        or (MyForm.Components[I] is TSpeedButton)
        or (MyForm.Components[I] is TStaticText)
        or (MyForm.Components[I] is TGroupBox)
        or (MyForm.Components[I] is TPanel)) then SetCaption(TLabel(MyForm.Components[I]))
      else if (MyForm.Components[I] is TLabeledEdit) then SetCaption(TLabeledEdit(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TRadioGroup)
        or (MyForm.Components[I] is TDBRadioGroup)) then SetCaption(TRadioGroup(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TListBox)
        or (MyForm.Components[I] is TDBListBox)
        or (MyForm.Components[I] is TCheckListBox)) then SetCaption(TListBox(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TComboBox)
        or (MyForm.Components[I] is TDBComboBox)) then SetCaption(TComboBox(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TStringGrid)) then SetCaption(TStringGrid(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TStatusBar)) then SetCaption(TStatusBar(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TListView)) then SetCaption(TListView(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TTabControl)) then SetCaption(TTabControl(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TPageControl)) then SetCaption(TPageControl(MyForm.Components[I]))
      else if ((MyForm.Components[I] is THeaderControl)) then SetCaption(THeaderControl(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TToolBar)) then SetCaption(TToolBar(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TADOConnection)) then SetCaption(TADOConnection(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TADOCommand)) then SetCaption(TADOCommand(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TADODataSet)) then SetCaption(TADODataSet(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TADOQuery)) then SetCaption(TADOQuery(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TADOTable)) then SetCaption(TADOTable(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TDBGrid)) then SetCaption(TDBGrid(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TMainMenu)) then SetCaption(TMainMenu(MyForm.Components[I]))
      else if ((MyForm.Components[I] is TMenuItem)) then SetCaption(TMenuItem(MyForm.Components[I]));
    end;
  end;
  InI.Free;
  UpdateProgress(1, 1);
  if Assigned(FOnDone) then FOnDone(self);
end;

function TLang.ReadInI(const Section, Ident, Default: string): string;
begin
  Result := InI.ReadString(Section, Ident, Default);
end;
procedure TLang.WriteInI(const Section, Ident, Value: string);
begin
  InI.WriteString(Section, Ident, Value);
end;

//设置Caption 部份
procedure TLang.SetCaption(SelfControl: TLabel);
var
  mTag, TCaption: string;
begin
  mTag := GetNum(SelfControl.Tag);
  TCaption := ReadInI(PageLayout, mTag, '');
  if TCaption = '' then WriteInI(PageLayout, mTag, SelfControl.Caption) else SelfControl.Caption := TCaption;
  SelfControl.Font.Name := FFontName;
  SelfControl.Font.Size := FFontSize;
end;

procedure TLang.SetCaption(SelfControl: TLabeledEdit);
var
  mTag, TCaption: string;
begin
  mTag := GetNum(SelfControl.Tag);
  TCaption := ReadInI(PageLayout, mTag, '');
  if TCaption = '' then WriteInI(PageLayout, mTag, SelfControl.EditLabel.Caption) else SelfControl.EditLabel.Caption := TCaption;
  SelfControl.Font.Name := FFontName;
  SelfControl.Font.Size := FFontSize;
end;

procedure TLang.SetCaption(SelfControl: TListView);
var
  mTag, TCaption: string;
  T1: TStrings;
  I: Integer;
begin
  mTag := GetNum(SelfControl.Tag);
  TCaption := ReadInI(PageLayout, mTag, '');
  T1 := TStringlist.Create;
  if TCaption = '' then begin
    T1.Clear;
    for I := 0 to SelfControl.Columns.Count - 1 do
      T1.Add(SelfControl.Columns[I].Caption);
    WriteInI(PageLayout, mTag, T1.CommaText);
  end else begin
    T1.Clear;
    T1.CommaText := TCaption;
    for I := 0 to SelfControl.Columns.Count - 1 do
      SelfControl.Columns[I].Caption := T1.Strings[I];
  end;
  T1.Free;
  SelfControl.Font.Name := FFontName;
  SelfControl.Font.Size := FFontSize;
end;

procedure TLang.SetCaption(SelfControl: TListBox);
var
  mTag, TCaption: string;
begin
  mTag := GetNum(SelfControl.Tag);
  TCaption := ReadInI(PageLayout, mTag, '');
  if TCaption = '' then WriteInI(PageLayout, mTag, SelfControl.Items.CommaText) else SelfControl.Items.CommaText := TCaption;
  SelfControl.Font.Name := FFontName;
  SelfControl.Font.Size := FFontSize;
end;


procedure TLang.SetCaption(SelfControl: TRadioGroup);
var
  mTag, TCaption: string;
begin
  mTag := GetNum(SelfControl.Tag);
  TCaption := ReadInI(PageLayout, mTag, '');
  if TCaption = '' then WriteInI(PageLayout, mTag, SelfControl.Caption) else SelfControl.Caption := TCaption;
  TCaption := ReadInI(PageLayout, mTag + '_Items', '');
  if TCaption = '' then WriteInI(PageLayout, mTag, SelfControl.Items.CommaText) else SelfControl.Items.CommaText := TCaption;
  SelfControl.Font.Name := FFontName;
  SelfControl.Font.Size := FFontSize;
end;

procedure TLang.SetCaption(SelfControl: TComboBox);
var
  mTag, TCaption: string;
begin
  mTag := GetNum(SelfControl.Tag);
  TCaption := ReadInI(PageLayout, mTag, '');
  if TCaption = '' then WriteInI(PageLayout, mTag, SelfControl.Items.CommaText) else SelfControl.Items.CommaText := TCaption;
  SelfControl.Font.Name := FFontName;
  SelfControl.Font.Size := FFontSize;
end;

procedure TLang.SetCaption(SelfControl: TStringGrid);
var
  mTag, TCaption: string;
begin
  mTag := GetNum(SelfControl.Tag);
  TCaption := ReadInI(PageLayout, mTag, '');
  if TCaption = '' then WriteInI(PageLayout, mTag, SelfControl.Rows[0].CommaText) else SelfControl.Rows[0].CommaText := TCaption;
  SelfControl.Font.Name := FFontName;
  SelfControl.Font.Size := FFontSize;
end;

procedure TLang.SetCaption(SelfControl: TStatusBar);
var
  mTag, TCaption: string;
  T1: TStrings;
  I: Integer;
begin
  mTag := GetNum(SelfControl.Tag);
  TCaption := ReadInI(PageLayout, mTag, '');
  T1 := TStringlist.Create;
  if TCaption = '' then