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.
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