多国语言解决方案

unit Unit1;

interface

uses
  inifiles,TypInfo,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Open1: TMenuItem;
    procedure FormShow(Sender: TObject);
    procedure lngMenuClick (Sender: TObject);
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


//查找语种目录下所有的语言配置文件
procedure SearchLanguagePack (lngStrings: TStrings); 
var
  DosError: Integer;
  SearchRec: TsearchRec;
begin
  DosError := FindFirst(ExtractFilePath(ParamStr(0))+'eps*.eps', faAnyFile, SearchRec);
  while DosError = 0 do
  begin
    lngStrings.Add(ChangeFileExt(SearchRec.Name, ''));//返回的文件名并去掉末尾的.eps字符
    DosError := FindNext(SearchRec);
  end;
  FindClose(SearchRec);
end;

//更换语言
function ChangeLanguage(Obj: TForm; Lang: string): Boolean;
var
  INIF : Tinifile;
  SL,TmpSL : TStringList;
  Key,CompName :string;
  I:Integer;
  AComponent:TComponent;
  CompProp,Value:string;
  procedure Explode(S: string; SplitChar: string; R: TStrings);
  var 
    P, L, C: Integer;
  begin
    R.Clear;
    L := Length (S);
    C := Length (SplitChar);
    repeat
    P := Pos(SplitChar, S);
    if P = 0 then C := 1;
    R.Add(Copy(S, P+C, L));
    Delete(S, P, L);
    until P = 0;
  end;// End Explode()

  //设置相应属性值
  procedure SetPropertyValue(AComponent: TComponent; sProperty, sValue: string);
  var
    PropInfo: PPropInfo;
    AStrings: TStringList;
  begin
    if AComponent <> nil then
    begin
      PropInfo := GetPropInfo(AComponent, sProperty);
      if PropInfo <> nil then
      begin
        case PropInfo.PropType^.Kind of
          tkString, tkLString: //字符串属性
          SetStrProp(AComponent, PropInfo, sValue);
          tkInteger: //序数属性
          SetOrdProp(AComponent, PropInfo, StrToInt(sValue));
        else
          if PropInfo.PropType^.Name = 'TStrings' then //列表属性
          begin
            AStrings := TStringList.Create;
            try
              Explode(sValue, '||', AStrings);
              SetOrdProp (AComponent, PropInfo, Integer (AStrings));
            finally
              AStrings.Free;
            end; // end try
          end; // end if PropInfo.PropType^.Name = 'TStrings'
        end; // end case
      end; // end if PropInfo <> nil
    end; // end if AComponent <> ni 
  end; //End SetPropertyValue();

begin
   Result := True;
   SL := TStringList.Create;
   TmpSL := TStringList.Create;
   INIF := Tinifile.Create(ExtractFilePath(paramstr(0))+'eps'+Lang+'.eps');
   INIF.ReadSectionValues (Obj.Name, SL);
   for I := 0 to SL.Count - 1 do
   begin
     Explode(SL.Strings[I], '=',TmpSL);
     Key := Trim (TmpSL.Strings[1]);
     CompName := Trim (Copy(Key, 1, Pos ('.', Key) - 1));
     if CompName = '' then
        AComponent := Obj
     else
        AComponent := Obj.FindComponent(CompName);
     CompProp := Trim(Copy (Key, Pos ('.', Key)+1, Length (Key)));
     Value := Trim (TmpSL.Strings[0]);
     SetPropertyValue(AComponent, CompProp, Value); // 设置属性
   end;
   INIF.Free;
   TmpSL.Free;
   SL.Free;
End;//End ChangeLanguage Function



procedure TForm1.FormShow(Sender: TObject);
var 
  lngStrings, tmpStrings: TStrings;
  I: Integer;
  lngMenu,M_Language: TMenuItem;
  Filename: string;
  IniF: TIniFile;
begin
  lngStrings := TStringList.Create;
  try
    SearchLanguagePack (lngStrings);
    if lngStrings.Count = 0 then
      exit;
    Filename := ExtractFilePath(ParamStr (0))+'eps' + lngStrings.Strings[0]+'.eps';
    IniF := TIniFile.Create(Filename);
    Filename := IniF.ReadString('Language', ' DefaultLang ', '');
    if Filename <> '' then
    begin
      Filename := ExtractFilePath (ParamStr(0))+'eps'+Filename+'.eps';
      if FileExists (Filename) then
      begin
        IniF.Free;
        IniF := TIniFile.Create (Filename);
      end;
    end;
    M_Language := TMenuItem.Create(self);
    M_Language.Name := 'lg_Language';
    M_Language.Caption := IniF.ReadString('Language', 'Language', 'Language');
    MainMenu1.Items.Add(M_Language);
    tmpStrings := TStringList.Create;
    try
      for I := 0 to lngStrings.Count - 1 do
      begin
        lngMenu := TMenuItem.Create (self);
        lngMenu.Name := lngStrings.Strings[I]; // 将菜单项的名称赋予文件名
        lngMenu.Caption := IniF.ReadString('Language', lngStrings.Strings[I], lngStrings.Strings[I]);
        lngMenu.onClick := lngMenuClick; // 菜单事件
        M_Language.Add(lngMenu); // 添加到语种菜单的最后一项上
      end;
    finally
      tmpStrings.Free;
    end; 
  finally
    lngStrings.Free;
  end;
  ChangeLanguage(Form1,'Chinese');
  IniF.Free;
end;

procedure TForm1.lngMenuClick (Sender: TObject); 
var
  Filename: string;
begin
  if Sender is TMenuItem then
  begin
    Filename := (Sender as TMenuItem).Name;
    ChangeLanguage(Form1, Filename);
  end;
end; 



end.

 

可是更换菜单语言的时候有点慢，谁有好的方案请给我一份
留言或[e-mail]