多国语言解决方案

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.

 

可是更换菜单语言的时候有点慢，谁有好的方案请给我一份
留言或hzqghost@21cn.com