//author: cxg
{ For example :
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
SetActiveLanguage(ComboBox1.Text);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ComboBox1.Items.AddStrings(SearchLanguagePack);
end;
}
unit uLanguage;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus, IniFiles, ComCtrls, ExtCtrls,
cxButtons
;
var
g_hash: THashedStringList;
//搜索ini文件生成语言列表
function SearchLanguagePack: TStrings;
//根据当前选择的语言设置指定窗体及其子控件的属性
procedure SetActiveLanguage(owner: TForm; const LanguageName: string);
//将指定窗体及其子控件的属性写入INI文件
procedure Writeproperty(owner: TForm; const LanguageName: string);
function GetHash: THashedStringList;
function GetHashStr(const key: string): string;
procedure SetLanguage(owner: TForm);
procedure WriteLangIni(owner: tform);
implementation
function GetHash: THashedStringList;
var
ini: TIniFile;
begin
ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'system.ini');
Result := THashedStringList(THandle(ini.ReadInteger('pointer', 'hash', 0)));
ini.Free;
end;
function GetHashStr(const key: string): string;
begin
Result := GetHash.Values[key];
end;
function _WriteLangIni: Boolean;
var
ini: TIniFile;
begin
ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'system.ini');
Result := ini.ReadBool('language', 'writelangini', false);
ini.Free;
end;
procedure WriteLangIni(owner: tform);
begin
if _WriteLangIni then
uLanguage.Writeproperty(owner, 'chinese(gb)');
end;
procedure SetLanguage(owner: TForm);
var
ini: TIniFile;
begin
ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'system.ini');
uLanguage.SetActiveLanguage(owner, ini.ReadString('language', 'currentlanguage', 'chinese(gb)'));
ini.Free;
end;
function SearchLanguagePack: TStrings;
var
ResultStrings: TStrings;
DosError: integer;
SearchRec: TsearchRec;
begin
ResultStrings := TStringList.Create;
DosError := FindFirst(ExtractFilePath(Application.ExeName) + 'language/' + '*.ini', faAnyFile, SearchRec);
while DosError = 0 do
begin
{ 返回的文件名并去掉末尾的.ini字符 }
ResultStrings.Add(ChangeFileExt(SearchRec.Name, ''));
DosError := FindNext(SearchRec);
end;
FindClose(SearchRec);
Result := ResultStrings;
end;
procedure Writeproperty(owner: TForm; const LanguageName: string);
var
c: TComponent;
i: Integer;
begin
if owner = nil then exit;
with TInifile.Create(ExtractFilePath(Application.ExeName) + 'language/' + LanguageName + '.ini') do
begin
WriteString(owner.Name, owner.Name + '.Caption', owner.Caption);
for i := 0 to owner.ComponentCount - 1 do
begin
c := owner.Components[i];
if c is TLabel then
begin
writeString(owner.Name, c.Name + '.Caption', (c as TLabel).Caption);
end else
if c is TLabeledEdit then
begin
writeString(owner.Name, c.Name + '.EditLabel.Caption', (c as TLabeledEdit).EditLabel.Caption);
end else
if c is TCheckBox then
begin
writeString(owner.Name, c.Name + '.Caption', (c as TCheckBox).Caption);
end else
if c is TButton then
begin
writeString(owner.Name, c.Name + '.Caption', (c as TButton).Caption);
writeString(owner.Name, c.Name + '.Hint', (c as TButton).Hint);
end else
if c is TcxButton then
begin
writeString(owner.Name, c.Name + '.Caption', (c as TcxButton).Caption);
writeString(owner.Name, c.Name + '.Hint', (c as TcxButton).Hint);
end else
if c is TMenuItem then
begin
writeString(owner.Name, c.Name + '.Caption', (c as TMenuItem).Caption);
end else
if c is TToolButton then
begin
writeString(owner.Name, c.Name + '.Caption', (c as TToolButton).Caption);
writeString(owner.Name, c.Name + '.Hint', (c as TToolButton).Hint);
end else
if c is TTabSheet then
begin
writeString(owner.Name, c.Name + '.Caption', (c as TTabSheet).Caption);
end;
end;
end;
end;
procedure SetActiveLanguage(owner: TForm; const LanguageName: string);
const
Messages = 'Messages'; //字符串变量小节
var
c: TComponent;
i: Integer;
ini: TIniFile;
begin
if owner = nil then exit;
ini := TInifile.Create(ExtractFilePath(Application.ExeName) + 'language/' + LanguageName + '.ini');
with ini do
begin
owner.Caption := readstring(owner.Name, owner.Name + '.Caption', owner.Caption);
for i := 0 to owner.ComponentCount - 1 do
begin
c := owner.Components[i];
if c is TLabel then
begin
(c as TLabel).Caption := ReadString(owner.Name, c.Name + '.Caption', (c as TLabel).Caption);
end else
if c is TLabeledEdit then
begin
(c as TLabeledEdit).EditLabel.Caption := ReadString(owner.Name, c.Name + '.EditLabel.Caption', (c as TLabeledEdit).EditLabel.Caption);
end else
if c is TCheckBox then
begin
(c as TCheckBox).Caption := ReadString(owner.Name, c.Name + '.Caption', (c as TCheckBox).Caption);
end else
if c is TButton then
begin
(c as TButton).Caption := ReadString(owner.Name, c.Name + '.Caption', (c as TButton).Caption);
(c as TButton).Hint := ReadString(owner.Name, c.Name + '.Hint', (c as TButton).Hint);
end else
if c is TcxButton then
begin
(c as TcxButton).Caption := ReadString(owner.Name, c.Name + '.Caption', (c as TcxButton).Caption);
(c as TcxButton).Hint := ReadString(owner.Name, c.Name + '.Hint', (c as TcxButton).Hint);
end else
if c is TMenuItem then
begin
(c as TMenuItem).Caption := ReadString(owner.Name, c.Name + '.Caption', (c as TMenuItem).Caption);
end else
if c is TToolButton then
begin
(c as TToolButton).Caption := ReadString(owner.Name, c.Name + '.Caption', (c as TToolButton).Caption);
(c as TToolButton).Hint := ReadString(owner.Name, c.Name + '.Hint', (c as TToolButton).Hint);
end else
if c is TTabSheet then
begin
(c as TTabSheet).Caption := ReadString(owner.Name, c.Name + '.Caption', (c as TTabSheet).Caption);
end;
end;
ReadSectionValues('messages', g_hash);
end;
ini.Free;
ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'system.ini');
ini.WriteInteger('pointer', 'hash', thandle(g_hash));
ini.Free;
end;
initialization
g_hash := THashedStringList.Create;
finalization
FreeAndNil(g_hash);
end.