vgnls.pas

大家是不是为不知道如何在VB学到绝地程序

{*******************************************************}
{                                                       }
{         Vladimir Gaitanoff Delphi VCL Library         }
{         National Language Support                     }
{                                                       }
{         Copyright (c) 1997, 2000                      }
{                                                       }
{*******************************************************}

{$I VG.INC }
{$D-,L-}

Unit vgNLS;

Interface
Uses
  SysUtils,
  Classes,
  IniFiles,
  vgStndrt;

Type
  TTranslateMsgEvent = Procedure(Sender: TObject; Const OldMsg: String; Var NewMsg: String) Of Object;

  TTranslatePropEvent = Procedure(Sender: TObject; Const PropPath, OldPropValue: String;
    Var NewPropValue: String) Of Object;

  TTranslatePropStringEvent = Procedure(Sender: TObject; Instance: TObject; Const PropName: String;
    Const OldPropValue: String; Var NewPropValue: String) Of Object;

  TTranslatePropInstanceEvent = Procedure(Sender: TObject; Instance: TObject) Of Object;

  {$IFNDEF _D4_}
  TCustomIniFile = TIniFile;
  {$ENDIF}

  { TvgCustomTranslator }
  TvgCustomTranslator = Class(TComponent)
  Private
    FActive, FStreamedActive: Boolean;
    FProps: TStrings;
    FRoot: TObject;
    FTransList: TList;
    FTransStack: String;
    FOnTranslateMsg: TTranslateMsgEvent;
    FOnTranslateProp: TTranslatePropEvent;
    FOnTranslatePropString: TTranslatePropStringEvent;
    FOnTranslatePropInstance: TTranslatePropInstanceEvent;
    Procedure SetActive(Value: Boolean);
    Procedure SetProps(Value: TStrings);
  Protected
    Procedure DoActivate; Virtual;
    Procedure DoDeactivate; Virtual;
    Function DoTranslateMsg(Const Msg: String): String; Virtual;
    Function DoTranslateProp(Const PropPath, PropValue: String): String; Virtual;
    Procedure DoTranslatePropString(Instance: TObject; Const PropName: String;
      Const OldPropValue: String; Var NewPropValue: String); Virtual;
    Procedure DoTranslatePropInstance(Instance: TObject); Virtual;
    Procedure Loaded; Override;
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Function TranslatePath: String;
    Function TranslatePathProp(Const PropName: String): String;
    Function TranslateProp(Const PropPath, PropValue: String): String;
    Procedure TranslatePropClass(Instance: TObject; Const PropName: String);
    Procedure TranslatePropString(Instance: TObject; Const PropName: String);
    Procedure TranslateProps(Instance: TObject);
    Function TranslateMessage(Const Msg: String): String;
    Function TranslateUserMessage(Const Msg: String): String; { For TLanguage compability }
    Function TMsg(Const Msg: String): String; { TranslateMessage macro }
    Procedure Translate;
    Property Root: TObject Read FRoot;
  Published
    Property Active: Boolean Read FActive Write SetActive Default False;
    Property Properties: TStrings Read FProps Write SetProps;
    Property OnTranslateMsg: TTranslateMsgEvent Read FOnTranslateMsg Write FOnTranslateMsg;
    Property OnTranslateProp: TTranslatePropEvent Read FOnTranslateProp Write FOnTranslateProp;
    Property OnTranslatePropString: TTranslatePropStringEvent Read FOnTranslatePropString Write FOnTranslatePropString;
    Property OnTranslatePropInstance: TTranslatePropInstanceEvent Read FOnTranslatePropInstance Write FOnTranslatePropInstance;
  End;

  { TvgTranslator }
  TvgTranslator = Class(TvgCustomTranslator)
  Private
    FInCreateFile: Boolean;
    FIniFileName: TFileName;
    FIniFile: TCustomIniFile;
    {$IFDEF _D4_}
    FAppIniFile: Boolean;
    FIniFileLink: TIniFileLink;
    {$ENDIF}
    Procedure SetIniFileName(Const Value: TFileName);
    {$IFDEF _D4_}
    Function GetAppIniFile: TAppIniFile;
    Procedure SetAppIniFile(Value: TAppIniFile);
    Procedure IniDestroy(Sender: TObject);
    {$ENDIF}
  Protected
    Procedure DoActivate; Override;
    Procedure DoDeactivate; Override;
    Function DoTranslateMsg(Const Msg: String): String; Override;
    Function DoTranslateProp(Const PropPath, PropValue: String): String; Override;
  Public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
    Procedure CreateLanguageFile(Const FileName: TFileName; SaveOld: Boolean);
    Property IniFile: TCustomIniFile Read FIniFile;
  Published
    Property Active: Boolean Read FActive Write SetActive Default False;
    {$IFDEF _D4_}
    Property AppIniFile: TAppIniFile Read GetAppIniFile Write SetAppIniFile;
    {$ENDIF}
    Property LanguageFile: TFileName Read FIniFileName Write SetIniFileName;
  End;

Const
  SectionTranslate = 'Translations';
  SectionMessages = 'Messages';

  { Utility routines }
Function TranslateStringsToString(Strings: TStrings): String;
Procedure TranslateStringToStrings(Msg: String; Strings: TStrings);
Function StrsToStr(Const s: String): String;
//'aaaa'
//'bbbb'
//Result := 'aaaa#13#10bbbb'
Function StrToStrs(Const s: String): String;

Implementation
Uses
  TypInfo,
  vgUtils,
  Forms;

Const
  StringProps = [TkString, TkLString];
  ClassProps = [TkClass];
  DefDelimeter = '.';

Function StrsToStr(Const s: String): String;
Var
  i: Integer;
Begin
  Result := '';
  For i := 1 To Length(s) Do
    If Ord(s[i]) < 20 Then Result := Result + '#' + IntToStr(Ord(s[i]))
    Else If s[i] = '#' Then Result := Result + '#' + s[i]
    Else Result := Result + s[i];
End;

Function StrToStrs(Const s: String): String;
Var
  i: Integer;
  t: String[2];
Begin
  Result := '';
  i := 1;
  While i <= Length(s) Do Begin
    If s[i] = '#' Then Begin
      Inc(i);
      t := '';
      t := s[i];
      Inc(i);
      t := t + s[i];
      If (t[1] In ['0'..'9']) And (t[2] In ['0'..'9']) Then
        Result := Result + Char(StrToInt(t))
      Else
        Result := Result + '#' + t;
    End
    Else Result := Result + s[i];
    Inc(i);
  End;
End;

Function TranslateStringsToString(Strings: TStrings): String;
Var
  S: String;
  I, J: Integer;
Begin
  Result := '';
  For I := 0 To Strings.Count - 1 Do Begin
    S := Strings[I];

    For J := 1 To Length(S) Do
      If S[J] = ',' Then
        Result := Result + ',,' Else
        Result := Result + S[J];

    Result := Result + ',';
  End;
  System.Delete(Result, Length(Result), 1);
End;

Procedure TranslateStringToStrings(Msg: String; Strings: TStrings);
Var
  P: PChar;
  Tmp: String;
Begin
  Strings.BeginUpdate;
  Try
    Strings.Clear;

    Tmp := '';
    P := PChar(Msg);
    While P^ <> #0 Do Begin
      If P^ = ',' Then Begin
        Inc(P);
        If (P^ <> ',') Then Begin
          Strings.Add(Tmp);
          Tmp := '';
          Continue;
        End;
      End;
      Tmp := Tmp + P^;
      Inc(P);
      If P^ = #0 Then Strings.Add(Tmp);
    End;
  Finally
    Strings.EndUpdate;
  End;
End;

{ TvgCustomTranslator }

Constructor TvgCustomTranslator.Create(AOwner: TComponent);
Begin
  Inherited;
  FProps := TStringList.Create;
End;

Destructor TvgCustomTranslator.Destroy;
Begin
  SetActive(False);
  FProps.Free;
  Inherited;
End;

Procedure TvgCustomTranslator.Loaded;
Begin
  Inherited;
  Try
    SetActive(FStreamedActive);
    If Not (CsDesigning In ComponentState) And Active Then
      Translate;
  Except
    If (CsDesigning In ComponentState) Then
      Application.HandleException(Self)
    Else
      Raise;
  End;
End;

Procedure TvgCustomTranslator.SetActive(Value: Boolean);
Begin
  If CsLoading In ComponentState Then
    FStreamedActive := Value
  Else If FActive <> Value Then Begin
    If Value Then
      DoActivate Else DoDeactivate;
    FActive := Value;
  End;
End;

Procedure TvgCustomTranslator.SetProps(Value: TStrings);
Begin
  FProps.Assign(Value);
End;

Procedure TvgCustomTranslator.DoActivate;
Begin
End;

Procedure TvgCustomTranslator.DoDeactivate;
Begin
End;

Function TvgCustomTranslator.DoTranslateMsg(Const Msg: String): String;
Begin
  Result := Msg;
  If Assigned(FOnTranslateMsg) Then
    FOnTranslateMsg(Self, Msg, Result);
End;

Function TvgCustomTranslator.DoTranslateProp(Const PropPath, PropValue: String): String;
Begin
  Result := PropValue;
  If Assigned(FOnTranslateProp) Then
    FOnTranslateProp(Self, PropPath, PropValue, Result);
End;

Procedure TvgCustomTranslator.DoTranslatePropString(Instance: TObject; Const PropName: String;
  Const OldPropValue: String; Var NewPropValue: String);
Var
  PropPath: String;
Begin
  PropPath := TranslatePathProp(PropName);

  If (FProps.Count = 0) Or (FProps.IndexOf(PropPath) >= 0) Then Begin
    If Assigned(FOnTranslatePropString) Then
      FOnTranslatePropString(Self, Instance, PropName, OldPropValue, NewPropValue) Else
      NewPropValue := TranslateProp(PropPath, OldPropValue);
  End;
End;

Procedure TvgCustomTranslator.DoTranslatePropInstance(Instance: TObject);
Var
  I: Integer;