delphi 实现多语言界面的最简单方法

基本原理：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.