vgnls.pas

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

  SaveStack: String;
  NewPropValue, OldPropValue: String;
Begin
  If Instance Is TStrings Then Begin
    OldPropValue := TranslateStringsToString(TStrings(Instance));
    NewPropValue := OldPropValue;
    DoTranslatePropString(Instance, '', OldPropValue, NewPropValue);
    If OldPropValue <> NewPropValue Then
      TranslateStringToStrings(NewPropValue, TStrings(Instance));
  End Else If Instance Is TCollection Then Begin
    SaveStack := FTransStack;
    Try
      For I := 0 To TCollection(Instance).Count - 1 Do Begin
        FTransStack := SaveStack + DefDelimeter + IntToStr(I);
        ;
        TranslateProps(TCollection(Instance).Items[I]);
      End;
    Finally
      FTransStack := SaveStack;
    End;
  End;

  If Assigned(FOnTranslatePropInstance) Then
    FOnTranslatePropInstance(Self, Instance);
End;

Function TvgCustomTranslator.TranslatePath: String;
Begin
  Result := FTransStack;
End;

Function TvgCustomTranslator.TranslatePathProp(Const PropName: String): String;
Begin
  If PropName <> '' Then
    Result := TranslatePath + DefDelimeter + PropName Else
    Result := TranslatePath;
End;

Function TvgCustomTranslator.TranslateProp(Const PropPath, PropValue: String): String;
Begin
  SetActive(True);
  Result := DoTranslateProp(PropPath, PropValue);
End;

Procedure TvgCustomTranslator.TranslatePropClass(Instance: TObject; Const PropName: String);
Var
  PropValue: TObject;
  SaveStack: String;
Begin
  PropValue := TObject(GetOrdProp(Instance, GetPropInfo(Instance.ClassInfo, PropName)));
  If Assigned(PropValue) And Not (PropValue Is TComponent) Then Begin
    SaveStack := FTransStack;
    FTransStack := FTransStack + DefDelimeter + PropName;
    Try
      TranslateProps(PropValue);
    Finally
      FTransStack := SaveStack;
    End;
  End;
End;

Procedure TvgCustomTranslator.TranslatePropString(Instance: TObject; Const PropName: String);
Var
  OldPropValue, NewPropValue: String;
Begin
  OldPropValue := GetStrProp(Instance, GetPropInfo(Instance.ClassInfo, PropName));
  NewPropValue := OldPropValue;
  DoTranslatePropString(Instance, PropName, OldPropValue, NewPropValue);
  If OldPropValue <> NewPropValue Then
    SetStrProp(Instance, GetPropInfo(Instance.ClassInfo, PropName), NewPropValue);
End;

Procedure TvgCustomTranslator.TranslateProps(Instance: TObject);

  Procedure DoTranslate(Instance: TComponent; Data: Pointer);
  Begin
    If Instance.Name <> '' Then
      TvgCustomTranslator(Data).TranslateProps(Instance);
  End;

  Function GetStackDelta: String;
  Begin
    If Instance Is TComponent Then
      Result := TComponent(Instance).Name Else
      Result := '';
  End;

Var
  I: Integer;
  StackDelta: String;
  List: TList;
  First: Boolean;
Begin
  Active := True;

  { Check for possible cross-references }
  First := Not Assigned(FTransList);
  If First Then FRoot := Instance;

  If (ListIndexOf(FTransList, Instance) >= 0) Or (Instance Is TComponent)
    And (Instance <> FRoot) And (ListIndexOf(FTransList, TComponent(Instance).Owner) < 0) Then Exit;

  ListAdd(FTransList, Instance);
  Try
    StackDelta := GetStackDelta;
    If StackDelta <> '' Then
      AddDelimeted(FTransStack, StackDelta, DefDelimeter);

    List := TList.Create;
    Try
      DoTranslatePropInstance(Instance);

      { String properties }
      GetPropInfoList(List, Instance, StringProps);
      For I := 0 To List.Count - 1 Do
        TranslatePropString(Instance, PPropInfo(List[I]).Name);

      { Class properties }
      GetPropInfoList(List, Instance, ClassProps);
      For I := 0 To List.Count - 1 Do
        TranslatePropClass(Instance, PPropInfo(List[I]).Name);

      { Nested components }
      If Instance Is TComponent Then
        ForEachComponent(TComponent(Instance), TComponent, @DoTranslate, Self, False);
    Finally
      List.Free;
    End;
  Finally
    If First Then Begin
      ListClear(FTransList);
      FRoot := Nil;
      FTransStack := '';
    End Else
      If StackDelta <> '' Then
      FTransStack := Copy(FTransStack, 1, Length(FTransStack) - Length(StackDelta) - 1);
  End;
End;

Function TvgCustomTranslator.TranslateMessage(Const Msg: String): String;
Begin
  SetActive(True);
  Result := DoTranslateMsg(Msg)
End;

Function TvgCustomTranslator.TranslateUserMessage(Const Msg: String): String;
Begin
  Result := TranslateMessage(Msg);
End;

Function TvgCustomTranslator.TMsg(Const Msg: String): String;
Begin
  Result := TranslateMessage(Msg);
End;

Procedure TvgCustomTranslator.Translate;
Begin
  If Assigned(Owner) Then TranslateProps(Owner);
End;

{ TvgTranslator }

Constructor TvgTranslator.Create(AOwner: TComponent);
Begin
  Inherited;
  {$IFDEF _D4_}
  FIniFileLink := TIniFileLink.Create;
  FIniFileLink.OnIniDestroy := IniDestroy;
  {$ENDIF}
End;

Destructor TvgTranslator.Destroy;
Begin
  {$IFDEF _D4_}
  FIniFileLink.Free;
  {$ENDIF}
  Inherited;
End;

{$IFDEF _D4_}

Function TvgTranslator.GetAppIniFile: TAppIniFile;
Begin
  Result := FIniFileLink.AppIniFile;
End;

Procedure TvgTranslator.SetAppIniFile(Value: TAppIniFile);
Var
  SaveActive: Boolean;
Begin
  If AppIniFile <> Value Then Begin
    SaveActive := Active;
    Active := False;
    SetIniFileName('');
    FIniFileLink.AppIniFile := Value;
    If Assigned(AppIniFile) Then
      Active := SaveActive;
  End;
End;

Procedure TvgTranslator.IniDestroy(Sender: TObject);
Begin
  Active := False;
End;
{$ENDIF}

Procedure TvgTranslator.DoActivate;
Begin
  {$IFDEF _D4_}
  If Assigned(AppIniFile) Then Begin
    If FInCreateFile And AppIniFile.BeginRead
      Or Not FInCreateFile And AppIniFile.BeginWrite Then Begin
      FIniFile := AppIniFile.IniFile;
      FAppIniFile := True;
      Exit;
    End;
  End;
  {$ENDIF}
  FIniFile := TIniFile.Create(FIniFileName);
End;

Procedure TvgTranslator.DoDeactivate;
Begin
  {$IFDEF _D4_}
  If FAppIniFile Then Begin
    If Assigned(AppIniFile) Then
      If FInCreateFile Then
        AppIniFile.EndWrite Else
        AppIniFile.EndRead;
    FAppIniFile := False;
    FIniFile := Nil;
  End Else
    {$ENDIF}Begin
    FIniFile.Free;
    FIniFile := Nil;
  End;
End;

Function TvgTranslator.DoTranslateMsg(Const Msg: String): String;
Begin
  Result := Msg;
  If Assigned(OnTranslateMsg) Then
    OnTranslateMsg(Self, Msg, Result)
  Else
    Result := FIniFile.ReadString(SectionMessages, Msg, Result);
End;

Function TvgTranslator.DoTranslateProp(Const PropPath, PropValue: String): String;
Begin
  Result := PropValue;
  If FInCreateFile Then Begin
    If PropValue <> '' Then
      FIniFile.WriteString(SectionTranslate, PropPath, {StrsToStr(} PropValue)
  End Else If Assigned(OnTranslateProp) Then
    OnTranslateProp(Self, PropPath, PropValue, Result)
  Else
    Result := StrToStrs(FIniFile.ReadString(SectionTranslate, PropPath, Result));
End;

Procedure TvgTranslator.SetIniFileName(Const Value: TFileName);
Var
  SaveActive: Boolean;
Begin
  If CsLoading In ComponentState Then
    FIniFileName := Value
  Else If FIniFileName <> Value Then Begin
    SaveActive := Active;
    Active := False;
    FIniFileName := Value;
    {$IFDEF _D4_}
    SetAppIniFile(Nil);
    {$ENDIF}
    If FIniFileName <> '' Then Active := SaveActive;
  End;
End;

Procedure TvgTranslator.CreateLanguageFile(Const FileName: TFileName; SaveOld: Boolean);
Var
  SaveActive: Boolean;
  SaveFileName: TFileName;
Begin
  If SaveOld Then
    CheckBackupFile(FileName) Else DeleteFile(FileName);

  SaveActive := Active;
  Try
    Active := False;

    Try
      SaveFileName := LanguageFile;
      LanguageFile := FileName;
      FInCreateFile := True;
      Try
        Translate;
      Finally
        FInCreateFile := False;
      End;
    Finally
      LanguageFile := SaveFileName;
    End;
  Finally
    Active := SaveActive;
  End;
End;

End.