这样做的一个优点是对原来单语的程序不需要做太大改动就可以实现双语，
给出主要的单元，部分代码网上获取，部分原创，希望对大家有帮助。
unit Cm_Language;
interface
uses
Windows, Forms, Classes, StdCtrls, Menus, Controls, ExtCtrls;
type
TLanguage = (
tNone,
tEnglish,
tGBChs,
tBig5,
tGBCht
);
TCaptionControl = class(TControl)
public
property Caption;
end;
function GetSysDefaultLg: TLanguage;
function Big5ToGB(BIG5Str: string): AnsiString;
function GBToBig5(GBStr: string): AnsiString;
function GBChtToChs(GBStr: string): AnsiString;
function GBChsToCht(GBStr: string): AnsiString;
function TranLanguage(SrcStr: string; SrcLan, DesLan: TLanguage): string;
procedure SetFormLanguage(sForm: TForm; SrcLan, DesLan: TLanguage);
implementation
//获取操作系统默认语言
// -1、无效 0、英语 1、简体中文 3、繁体中文
function GetSysDefaultLg: TLanguage;
var
LangID: Integer;
begin
Result := tNone;
LangID := GetSystemDefaultLangID;
if LangID = ((SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH) then
Result := tEnglish //美国英语
else if LangID = ((SUBLANG_CHINESE_SIMPLIFIED shl 10) or LANG_CHINESE) then
Result := tGBChs //简体中文
else if LangID = ((SUBLANG_CHINESE_TRADITIONAL shl 10) or LANG_CHINESE) then
Result := tBig5; //繁体中文
end;
function Big5ToGB(BIG5Str: string): AnsiString;
{进行big5转GB内码}
var
Len: Integer;
pBIG5Char: PChar;
pGBCHSChar: PChar;
pGBCHTChar: PChar;
pUniCodeChar: PWideChar;
begin
//String -> PChar
pBIG5Char := PChar(BIG5Str);
Len := MultiByteToWideChar(950, 0, pBIG5Char, -1, nil, 0);
GetMem(pUniCodeChar, Len * 2);
ZeroMemory(pUniCodeChar, Len * 2);
//Big5 -> UniCode
MultiByteToWideChar(950, 0, pBIG5Char, -1, pUniCodeChar, Len);
Len := WideCharToMultiByte(936, 0, pUniCodeChar, -1, nil, 0, nil, nil);
GetMem(pGBCHTChar, Len * 2);
GetMem(pGBCHSChar, Len * 2);
ZeroMemory(pGBCHTChar, Len * 2);
ZeroMemory(pGBCHSChar, Len * 2);
//UniCode->GB CHT
WideCharToMultiByte(936, 0, pUniCodeChar, -1, pGBCHTChar, Len, nil, nil);
//GB CHT -> GB CHS
LCMapString($804, LCMAP_SIMPLIFIED_CHINESE, pGBCHTChar, -1, pGBCHSChar, Len);
Result := string(pGBCHSChar);
FreeMem(pGBCHTChar);
FreeMem(pGBCHSChar);
FreeMem(pUniCodeChar);
end;
function GBToBig5(GBStr: string): AnsiString;
{进行GB转BIG5内码}
var
Len: Integer;
pGBCHTChar: PChar;
pGBCHSChar: PChar;
pUniCodeChar: PWideChar;
pBIG5Char: PChar;
begin
pGBCHSChar := PChar(GBStr);
Len := MultiByteToWideChar(936, 0, pGBCHSChar, -1, nil, 0);
GetMem(pGBCHTChar, Len * 2 + 1);
ZeroMemory(pGBCHTChar, Len * 2 + 1);
//GB CHS -> GB CHT
LCMapString($804, LCMAP_TRADITIONAL_CHINESE, pGBCHSChar, -1, pGBCHTChar, Len * 2);
GetMem(pUniCodeChar, Len * 2);
ZeroMemory(pUniCodeChar, Len * 2);
//GB CHT -> UniCode
MultiByteToWideChar(936, 0, pGBCHTChar, -1, pUniCodeChar, Len * 2);
Len := WideCharToMultiByte(950, 0, pUniCodeChar, -1, nil, 0, nil, nil);
GetMem(pBIG5Char, Len);
ZeroMemory(pBIG5Char, Len);
//UniCode -> Big5
WideCharToMultiByte(950, 0, pUniCodeChar, -1, pBIG5Char, Len, nil, nil);
Result := string(pBIG5Char);
FreeMem(pBIG5Char);
FreeMem(pGBCHTChar);
FreeMem(pUniCodeChar);
end;
function GBChtToChs(GBStr: string): AnsiString;
{进行GBK繁体转简体}
var
Len: Integer;
pGBCHTChar: PChar;
pGBCHSChar: PChar;
begin
pGBCHTChar := PChar(GBStr);
Len := MultiByteToWideChar(936, 0, pGBCHTChar, -1, nil, 0);
GetMem(pGBCHSChar, Len * 2 + 1);
ZeroMemory(pGBCHSChar, Len * 2 + 1);
//GB CHS -> GB CHT
LCMapString($804, LCMAP_SIMPLIFIED_CHINESE, pGBCHTChar, -1, pGBCHSChar, Len * 2);
Result := string(pGBChsChar);
//FreeMem(pGBCHTChar);
FreeMem(pGBCHSChar);
end;
function GBChsToCht(GBStr: string): AnsiString;
{进行GBK简体转繁体}
var
Len: Integer;
pGBCHTChar: PChar;
pGBCHSChar: PChar;
begin
pGBCHSChar := PChar(GBStr);
Len := MultiByteToWideChar(936, 0, pGBCHSChar, -1, nil, 0);
GetMem(pGBCHTChar, Len * 2 + 1);
ZeroMemory(pGBCHTChar, Len * 2 + 1);
//GB CHS -> GB CHT
LCMapString($804, LCMAP_TRADITIONAL_CHINESE, pGBCHSChar, -1, pGBCHTChar, Len * 2);
Result := string(pGBCHTChar);
FreeMem(pGBCHTChar);
//FreeMem(pGBCHSChar);
end;
procedure SetFormLanguage(sForm: TForm; SrcLan, DesLan: TLanguage);
var
TmpComp: TComponent;
TmpControl: TControl;
i, j, Len, Index: Integer;
TmpCap: string;
begin
with sForm do
begin
for i := 0 to ComponentCount - 1 do
begin
TmpComp := Components;
//控件Caption
if TmpComp is TControl then
begin
TmpControl := TmpComp as TControl;
Len := TmpControl.GetTextLen;
if Len <> 0 then
begin
SetString(TmpCap, PChar(nil), Len);
TmpControl.GetTextBuf(Pointer(TmpCap), Len + 1);
TmpControl.SetTextBuf(PChar(TranLanguage(TmpCap, SrcLan, DesLan)));
end;
end;
//其他情况
if TmpComp is TComboBox then
begin
with TmpComp as TComboBox do
begin
Index := ItemIndex;
for j := 0 to Items.Count - 1 do
Items[j] := TranLanguage(Items[j], SrcLan, DesLan);
ItemIndex := Index;
end;
end;
if TmpComp is TLabeledEdit then
begin
with TmpComp as TLabeledEdit do
EditLabel.Caption := TranLanguage(EditLabel.Caption, SrcLan, DesLan);
end;
end;
end;
end;
function TranLanguage(SrcStr: string; SrcLan, DesLan: TLanguage): string;
begin
Result := '';
if SrcLan = DesLan then
begin
Result := SrcStr;
exit;
end;
case SrcLan of
tNone, tEnglish:
exit;
tGBChs:
case DesLan of
tGBCht:
Result := GBChsToCht(SrcStr);
tBig5:
Result := GBToBig5(SrcStr);
end;
tGBCht:
case DesLan of
tGBChs:
Result := GBChtToChs(SrcStr);
tBig5:
Result := GBToBig5(SrcStr);
end;
tBig5:
case DesLan of
tGBChs:
Result := Big5ToGB(SrcStr);
tGBCht:
Result := GBChsToCht(Big5ToGB(SrcStr));
end;
end;
end;
end.
function Mt_MessageDlg(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer;
begin
MessageDlg(TranLanguage(Msg, tGBChs, Language_Select), DlgType, Buttons, HelpCtx);
end;
