基本原理：Delphi 的VCL是通过TReader 类来对控件进行读写的,再加上VCL的源码开放性,通过修改可以
它,使界面的资源从ini文件中读取:
1、在classes.pas中添加：
{!$IFDEF _MULTILANG}
function CL(const s: WideString): String;
begin
{$IFDEF _MULTILANG}
Result := ConvertLanguage(s);
{$ELSE}
Result := s;
{$ENDIF}
end;
{!$ENDIF}2、TReader.ReadString:
function TReader.ReadString: string;
var
L: Integer;
begin
if NextValue in [vaWString, vaUTF8String] then
Result := ReadWideString
else
begin
L := 0;
case ReadValue of
vaString:
Read(L, SizeOf(Byte));
vaLString:
Read(L, SizeOf(Integer));
else
PropValueError;
end;
SetLength(Result, L);
Read(Pointer(Result)^, L);
{$IFDEF _MULTILANG}
Result := ConvertLanguage(Result);
{$ENDIF}
end;
end;3、TReader.ReadString:
function TReader.ReadWideString: WideString;
var
L: Integer;
Temp: UTF8String;
begin
if NextValue in [vaString, vaLString] then
Result := ReadString
else
begin
L := 0;
case ReadValue of
vaWString:
begin
Read(L, SizeOf(Integer));
SetLength(Result, L);
Read(Pointer(Result)^, L * 2);
end;
vaUTF8String:
begin
Read(L, SizeOf(Integer));
SetLength(Temp, L);
Read(Pointer(Temp)^, L);
Result := Utf8Decode(Temp);
end;
else
PropValueError;
end;
{$IFDEF _MULTILANG}
Result := ConvertLanguage(Result);
{$ENDIF}
end;
end;4.MultiLanguage.pas代码：
{$DEFINE _WRITE_LANGFILE}
unit MultiLang;
interface
const
cLangFileName = 'language.ini';
function ConvertLanguage(const s: WideString): WideString;
implementation
uses
windows, SysUtils, classes, IniFiles;
const
UTF8TextFileTag: string = #$EF#$BB#$BF;
var
ClSrLst: TStringList=nil;
ClDtLst: TStringList=nil;
ClWrLst: TStringList=nil;
FIsModify:Boolean=False;
function WideStrPos(const Patt, SearchStr: WideString): integer;
var
PP, PS, PsBk: PWideChar;
isHas: Boolean;
begin
Result := 0;
PP := PWideChar(Patt);
PS := PWideChar(SearchStr);
PsBk := PS;
isHas := False;
if (PP<>nil) and (PP^<>#0) and
(PS <> nil) and (PS^ <> #0) then
begin
while (PS^ <> #0) do
begin
if(PS^ = PP^) then
begin
if not isHas then
begin
isHas := True;
PsBk := PS;
end;
inc(PP);
if PP^ = #0 then
begin
Result := (PsBk - PWideChar(SearChStr)) + 1;
Break;
end;
end
else if isHas then
begin
isHas := False;
PP := PWideChar(Patt);
PS := PsBk + 1;
end;
inc(PS);
end;
end;
end;
function WideStrCopy(const s: WideString; Offset, Len: Integer): WideString;
var
P: PWideChar;
aLen: Integer;
i: integer;
begin
Result := '';
if s <> '' then
begin
aLen := Length(s) - Offset + 1;
if Len < aLen then
aLen := Len;
if aLen > 0 then
begin
SetLength(Result, aLen);
p := PWideChar(s) + Offset - 1;
for i := 1 to aLen do
begin
Result[i] := p^;
inc(p);
end;
end;
end;
end;
function WideStrReplace(const S, OldPattern, NewPattern: WideString;
Flags: TReplaceFlags): WideString;
var
SearchStr, Patt, NewStr: WideString;
Offset: Integer;
begin
if rfIgnoreCase in Flags then
begin
SearchStr := WideUpperCase(S);
Patt := WideUpperCase(OldPattern);
end else
begin
SearchStr := S;
Patt := OldPattern;
end;
NewStr := S;
Result := '';
while SearchStr <> '' do
begin
Offset := WideStrPos(Patt, SearchStr);
if Offset = 0 then
begin
Result := Result + NewStr;
Break;
end;
Result := Result + WideStrCopy(NewStr, 1, Offset - 1) + NewPattern;
NewStr := WideStrCopy(NewStr, Offset + Length(OldPattern), MaxInt);
if not (rfReplaceAll in Flags) then
begin
Result := Result + NewStr;
Break;
end;
SearchStr := WideStrCopy(SearchStr, Offset + Length(Patt), MaxInt);
end;
end;
function ECode(s: WideString): WideString;
var
tmps: widestring;
begin
tmps := #13#10;
s := WideStrReplace(s, tmps, '{#13#10}', [rfReplaceAll]);
tmps := #10;
s := WideStrReplace(s, tmps, '{#13#10}', [rfReplaceAll]);
s := WideStrReplace(s, '=', '{#61}' , [rfReplaceAll]);
s := WideStrReplace(s, '"', '{#34}' , [rfReplaceAll]);
s := WideStrReplace(s, '''', '{#39}' , [rfReplaceAll]);
Result := s;
end;
function DCode(s: WideString): WideString;
var
tmps: widestring;
begin
tmps := #13#10;
s := WideStrReplace(s, '{#13#10}', tmps, [rfReplaceAll]);
s := WideStrReplace(s, '{#61}' , '=', [rfReplaceAll]);
s := WideStrReplace(s, '{#34}' , '"', [rfReplaceAll]);
s := WideStrReplace(s, '{#39}' , '''', [rfReplaceAll]);
Result := s;
end;
function InternalCl(const Sr: WideString; var Dt: WideString): Boolean;
var
Index: Integer;
begin
Result := False;
if ClSrLst.Find(Utf8Encode(ECode(Sr)), Index) then
begin
Index := Integer(ClSrLst.Objects[Index]);
if Index > 0 then
begin
Dt := DCode(Utf8Decode(ClDtLst[Index]));
Result := True;
end;
end;
end;
procedure Addc(s: WideString);
var
Utf8s: UTF8String;
begin
Utf8s := Utf8Encode(ECode(s)) + '=';
if clWrLst.IndexOf(s) = -1 then
begin
FIsModify := True;
ClWrLst.Add(Utf8s);
end;
end;
function ConvertLanguage(const s: WideString): WideString;
var
Dt: WideString;
begin
if InternalCl(s, Dt) then
begin
if Dt <> '' then
Result := Dt
else
Result := s;
end
else
begin
{$IFDEF _WRITE_LANGFILE}
Addc(s);
{$ENDIF}
result := s;
end;
end;
procedure init;
var
i, ci, Index: integer;
begin
ClDtLst.Add('no use');
for i := 0 to ClSrLst.Count - 1 do
begin
ci := Pos('=', ClSrLst[i]);
if ci = 0 then
Index := ClDtLst.Add('')
else
Index := ClDtLst.Add(Copy(ClSrLst[i], ci + 1, High(Integer)));
ClSrLst.Objects[i] := TObject(Index);
ClSrLst[i] := Copy(ClSrLst[i], 1, ci - 1);
end;
end;
initialization
ClSrLst := TStringList.Create;
if FileExists(ExtractFilePath(ParamStr(0)) + cLangFileName) then
ClSrLst.LoadFromFile(ExtractFilePath(ParamStr(0)) + cLangFileName);
if Copy(ClSrLst.Text, 1, Length(UTF8TextFileTag)) = UTF8TextFileTag then
ClSrLst.Text := Copy(ClSrLst.Text, Length(UTF8TextFileTag) + 1, high(Integer));
ClDtLst := TStringList.Create;
ClWrLst := TStringList.Create;
ClWrLst.Sorted := True;
init;
ClSrLst.Sorted := True;
finalization
{$IFDEF _WRITE_LANGFILE}
if FIsModify then
begin
try
if FileExists(ExtractFilePath(ParamStr(0)) + cLangFileName) then
ClSrLst.LoadFromFile(ExtractFilePath(ParamStr(0)) + cLangFileName);
except
On EFOpenError do;
end;
ClWrLst.AddStrings(ClSrLst);
try
ClWrLst.SaveToFile(ExtractFilePath(ParamStr(0)) + cLangFileName);
except
end;
end;
{$ENDIF}
FreeAndNil(ClWrLst);
FreeAndNil(ClSrLst);
FreeAndNil(ClDtLst);
end.