{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvTranslator.PAS, released on 2002-06-03

The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

Contributor(s): _________________________________.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvTranslator.pas 11879 2008-09-02 08:07:19Z obones $

unit JvTranslator;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes, IniFiles,
  Forms, ComCtrls, Menus, Dialogs,
  JvSimpleXml, JvComponentBase,
  JclSimpleXML;

type
  TJvTranslator = class(TJvComponent)
  private
    FXML: TJvSimpleXml;
    FSkipList: TList;
    function IsObject(const Obj: TClass; const ClassName: string): Boolean;
  protected
    function FindItemNamed(Root: TJvSimpleXMLElem; const AName: string;
      ARecurse: Boolean = False): TJvSimpleXMLElem; virtual;
    procedure TranslateComponent(const Component: TComponent; const Elem: TJvSimpleXMLElem); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    // Call SkipClass to register a class to skip when reading/writing
    procedure SkipClass(AClass: TClass);
    // Call UnskipClass to unregister a class so it won't be skip when reading/writing
    procedure UnskipClass(AClass: TClass);
    // Call SkipProperty to register a class property to skip when reading/writing
    // If UnskipClass has already been called for this class, does nothing
    procedure SkipProperty(AClass: TClass; const PropName: string);
    // Call UnskipProperty to unregister a class property so it won't be skipped when reading/writing
    // If SkipClass has already been called for this class, does nothing
    procedure UnskipProperty(AClass: TClass; const PropName: string);
    // Returns True if the specifed class/object/property is in the skip list
    function InSkipList(AClass: TClass): Boolean; overload;
    function InSkipList(Obj: TObject): Boolean; overload;
    function InSkipList(AClass: TClass; const PropName: string): Boolean; overload;
    function InSkipList(Obj: TObject; const PropName: string): Boolean; overload;
    procedure ClearSkipList;
    // ComponentToXML converts a TComponent and, optionally, it's owned components to an XML string
    // and returns it
    function ComponentToXML(const AComponent: TComponent; Recurse: Boolean): string;
    // Translate the entire Application using the file Filename
    procedure Translate(const FileName: string); overload;
    // Translate the entire Application using a stream
    procedure Translate(const Stream: TStream); overload;
    // Translate the entire Application using a string
    procedure TranslateString(const S: string); overload;
    // Translate a form using the file Filename
    procedure Translate(const FileName: string; const Form: TCustomForm); overload;
    // Translate a form using a stream
    procedure Translate(const Stream: TStream; const Form: TCustomForm); overload;
    // Translate a form using a string
    procedure TranslateString(const S: string; const Form: TCustomForm); overload;
    // Translate a form using the currently loaded XML (wherever it came from)
    procedure Translate(const Form: TCustomForm); overload;
    // Translates all form instances owned by the global screen object using the file Filename
    procedure TranslateScreen(const FileName: string); overload;
    // Translates all form instances owned by the global screen object using a stream
    procedure TranslateScreen(const Stream: TStream); overload;
    // Translates all form instances owned by the global screen object using a string
    procedure TranslateScreenString(const S: string);
    // Returns the value of a node or a property value of a node based on certain search criteria.
    // To find the value, the method first searches the root for a subnode with the name in Category.
    // If found, Category is searched for a subnode with the name in Item. If found, either the value
    // of Item or the value of a property named "Value" in Item is returned.
    // Structurally it should look something like this:
    // <Root>
    //   <Category>
    //     <Item Value="PropValue">Value</Item>
    //   </Category>
    //   ....
    // This method returns either Value or, if not found, PropValue or, if not found, an empty string
    function Translate(const Category, Item: string): string; overload;
    property XML: TJvSimpleXml read FXML;
  end;

  TJvTranslatorStrings = class(TJvComponent)
  private
    FList: THashedStringList;
    function GetString(Index: Integer): string;
    procedure SetString(Index: Integer; const Value: string);
    function GetCount: Integer;
    function GetValue(Index: Integer): string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IndexOf(const Name: string): Integer;
    function Add(const Name: string; var Value: string): Integer;
    // (p3) this is weird: GetString returns the *Name* but SetString sets the *Value*...
    property Strings[Index: Integer]: string read GetString write SetString; default;
    property Value[Index: Integer]: string read GetValue;
    property Count: Integer read GetCount;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/trunk/jvcl/run/JvTranslator.pas $';
    Revision: '$Revision: 11879 $';
    Date: '$Date: 2008-09-02 10:07:19 +0200 (mar., 02 sept. 2008) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  TypInfo,
  {$IFDEF SUPPORTS_INLINE}
  Windows,
  {$ENDIF SUPPORTS_INLINE}
  JclStreams,
  JvConsts;

const
  cName = 'Name';
  cItem = 'Item';
  cIndex = 'Index';
  cColumn = 'Column';
  cValue = 'Value';
  cVariables = 'Variables';
  cTTreeNodes = 'TTreeNodes';
  cTListItems = 'TListItems';
  cTStrings = 'TStrings';
  cTCollection = 'TCollection';
  cTComponent = 'TComponent';
  cTJvTranslatorStrings = 'TJvTranslatorStrings';
  cNewline = '\n';

type
  PSkipPropRec = ^TSkipPropRec;
  TSkipPropRec = record
    AClass: TClass;
    AProps: TStringList;
  end;

function InternalGetWideStrProp(Instance: TObject; const PropName: string): WideString; overload;
begin
  {$IFDEF COMPILER6_UP}
  Result := GetWideStrProp(Instance, PropName);
  {$ELSE}
  Result := GetStrProp(Instance, PropName);
  {$ENDIF COMPILER6_UP}
end;

function InternalGetPropList(AObject: TObject; out PropList: PPropList): Integer;
begin
  {$IFDEF COMPILER6_UP}
  Result := GetPropList(AObject, PropList);
  {$ELSE}
  Result := GetTypeData(AObject.ClassInfo)^.PropCount;
  if Result > 0 then
  begin
    GetMem(PropList, Result * SizeOf(Pointer));
    GetPropInfos(AObject.ClassInfo, PropList);
  end;
  Result := GetPropList(AObject.ClassInfo, tkProperties, PropList);
  {$ENDIF COMPILER6_UP}
end;

//=== { TJvTranslator } ======================================================

constructor TJvTranslator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FXML := TJvSimpleXml.Create(nil);
  SkipProperty(TComponent, cName);
end;

destructor TJvTranslator.Destroy;
begin
  FXML.Free;
  ClearSkipList;
  FreeAndNil(FSkipList);
  inherited Destroy;
end;

function TJvTranslator.FindItemNamed(Root: TJvSimpleXMLElem; const AName: string; ARecurse: Boolean): TJvSimpleXMLElem;
var
  I: Integer;
begin
  Result := nil;
  if Root = nil then
    Root := FXML.Root;
  if AnsiSameText(Root.Name, AName) then
    Result := Root
  else
  if not ARecurse then
    Result := Root.Items.ItemNamed[AName]
  else
    for I := 0 to Root.Items.Count - 1 do
    begin
      Result := FindItemNamed(Root.Items[I], AName, True);
      if Result <> nil then
        Break;
    end;
end;

function TJvTranslator.IsObject(const Obj: TClass; const ClassName: string): Boolean;
begin
  if Obj = nil then
    Result := False
  else
    Result := SameText(Obj.ClassName, ClassName) or (IsObject(Obj.ClassParent, ClassName));
end;

function TJvTranslator.ComponentToXML(const AComponent: TComponent; Recurse: Boolean): string;
var
  AName: string;
  AElem: TJvSimpleXMLElem;
  JclStream: TJclStringStream;
  StringStream: TStringStream;

  procedure CollectionToXML(Collection: TCollection; Elem: TJvSimpleXMLElem; Recurse:Boolean); forward;

  procedure TreeNodesToXML(Nodes: TTreeNodes; Elem: TJvSimpleXMLElem);
  var
    N: TTreeNode;
    AElem: TJvSimpleXMLElem;
  begin
    // format: <Items>
    //           <Item Index="" Value="" />
    // TODO
    if InSkipList(Nodes) then
      Exit;
    N := Nodes.GetFirstNode;
    while Assigned(N) do
    begin
      if not InSkipList(N) then
      begin
        AElem := Elem.Items.Add(cItem);
        AElem.Properties.Add(cIndex, N.Index);
        AElem.Properties.Add(cValue, N.Text);
      end;
      {
            AElem.Properties.Add('ImageIndex',N.ImageIndex);
            AElem.Properties.Add('SelectedIndex',N.SelectedIndex);
      }
      N := N.GetNext;
    end;
  end;

  procedure ListItemsToXML(Items: TListItems; Elem: TJvSimpleXMLElem);
  var
    I, J: Integer;
    AElem: TJvSimpleXMLElem;
  begin
    // format: <Items>
    //           <Item Index="" Column="" Value="" />
    // TODO
    if InSkipList(Items) then
      Exit;
    for I := 0 to Items.Count - 1 do
    begin
      if not InSkipList(Items[I]) then
      begin
        AElem := Elem.Items.Add(cItem);
        AElem.Properties.Add(cIndex, I);
        AElem.Properties.Add(cColumn, 0);
        AElem.Properties.Add(cValue, Items[I].Caption);
        for J := 0 to Items[I].SubItems.Count - 1 do
        begin
          AElem := Elem.Items.Add(cItem);
          AElem.Properties.Add(cIndex, I);
          AElem.Properties.Add(cColumn, J + 1);
          AElem.Properties.Add(cValue, Items[I].SubItems[J]);
        end;
      end;
    end;
  end;

  procedure StringsToXML(Strings: TStrings; Elem: TJvSimpleXMLElem);
  var
    I: Integer;
    AElem: TJvSimpleXMLElem;
  begin
    // format: <Items>
    //           <Item Index="" Value="" />
    if InSkipList(Strings) then
      Exit;
    for I := 0 to Strings.Count - 1 do
    begin
      AElem := Elem.Items.Add(cItem);
      AElem.Properties.Add(cIndex, I);
      AElem.Properties.Add(cValue, Strings[I]);
    end;
  end;

  procedure TranslatorStringsToXML(AStrings: TJvTranslatorStrings; Elem: TJvSimpleXMLElem);
  var
    I: Integer;
    AElem: TJvSimpleXMLElem;
  begin
    // I'm not sure how to create a translation template for this component, so this is just a guess...
    // format:
    // <Variables>
    //   <Item Name="" Value="" />
    // </Variables>
    if InSkipList(AStrings) then
      Exit;
    Elem.Name := cVariables;
    for I := 0 to AStrings.Count - 1 do
    begin
      AElem := Elem.Items.Add(cItem);
      AElem.Properties.Add(cName, AStrings[I]);
      AElem.Properties.Add(cValue, AStrings.Value[I]);
    end;
  end;
(*
  procedure ObjectToXML(AnObject: TObject; Elem: TJvSimpleXMLElem);
  var
    J, Count: Integer;
    PropList: PPropList;
    PropName: string;
    PropInfo: PPropInfo;
    AnObj: TObject;
  begin
    if (AnObject <> nil) and not InSkipList(AnObject) then
    begin
      Count := InternalGetPropList(AnObject, PropList);
      for J := 0 to Count - 1 do
      begin
        PropInfo := PropList[J];
        PropName := PropInfo^.Name;
        try
          if (PropInfo^.SetProc = nil) or InSkipList(AnObject, PropName) then
            Continue;
          case PropInfo^.PropType^.Kind of
            tkInteger:
              Elem.Properties.Add(PropName, GetOrdProp(AnObject, PropName));
            tkEnumeration:
              Elem.Properties.Add(PropName, GetEnumProp(AnObject, PropName));
            tkSet:
              Elem.Properties.Add(PropName, GetSetProp(AnObject, PropName));
            {$IFDEF UNICODE} tkUString, {$ENDIF}
            tkString, tkLString:
              Elem.Properties.Add(PropName, GetStrProp(AnObject, PropName));
            tkClass:
              begin
                AnObj := GetObjectProp(AnObject, PropName);
                if IsObject(AnObj.ClassType, cTTreeNodes) then
                  TreeNodesToXML(TTreeNodes(AnObj), Elem.Items.Add(PropName))
                else
                if IsObject(AnObj.ClassType, cTListItems) then
                  ListItemsToXML(TListItems(AnObj), Elem.Items.Add(PropName))
                else
                if IsObject(AnObj.ClassType, cTStrings) then
                  StringsToXML(TStrings(AnObj), Elem.Items.Add(PropName))
                else
                if IsObject(AnObj.ClassType, cTCollection) then
                  CollectionToXML(TCollection(AnObj), Elem.Items.Add(PropName))
                else
                if not IsObject(AnObj.ClassType, cTComponent) then
                  // NB! TComponents are excluded because most of the time, a published TComponent
                  // property references another component on the form. In some cases, however, a TComponent
                  // *can* be an internal component and this code won't list it.
                  // No known solution yet (no, HasParent/GetParentComponent doesn't work here)
                  ObjectToXML(AnObj, Elem.Items.Add(PropName));
              end;
          end;
        except
          //
        end;
      end;
    end;
  end;
*)
  procedure InnerComponentToXML(AComponent: TObject; Elem: TJvSimpleXMLElem; Recurse: Boolean);
  var
    I, Count: Integer;
    PropList: PPropList;
    PropName: string;
    PropInfo: PPropInfo;
    AnObj: TObject;
  begin
    if AComponent = nil then
      Exit;
    if not InSkipList(AComponent) then
    begin
      if IsObject(AComponent.ClassType, cTJvTranslatorStrings) then
      begin
        TranslatorStringsToXML(TJvTranslatorStrings(AComponent), Elem);
        Exit;
      end;
      Count := InternalGetPropList(AComponent, PropList);
      for I := 0 to Count - 1 do
      begin
        PropInfo := PropList[I];
        PropName := {$IFDEF SUPPORTS_UNICODE}UTF8ToString{$ENDIF SUPPORTS_UNICODE}(PropInfo^.Name);

        if InSkipList(AComponent, PropName) or (PropInfo^.SetProc = nil) then
          Continue;
        case PropInfo^.PropType^.Kind of
          tkInteger:
            Elem.Properties.Add(PropName, GetOrdProp(AComponent, PropName));
          tkEnumeration:
            Elem.Properties.Add(PropName, GetEnumProp(AComponent, PropName));
          tkSet:
            Elem.Properties.Add(PropName, GetSetProp(AComponent, PropName));
          {$IFDEF UNICODE} tkUString, {$ENDIF}
          tkString, tkLString, tkWString:
            Elem.Properties.Add(PropName, XMLEncode(InternalGetWideStrProp(AComponent, PropName)));
          tkClass:
            begin
              AnObj := GetObjectProp(AComponent, PropName);

              // The property may not be assigned (action, popupmenu...), in
              // this case, we can't do anything with it.
              if not Assigned(AnObj) then
                Continue;

              if IsObject(AnObj.ClassType, cTTreeNodes) then
                TreeNodesToXML(TTreeNodes(AnObj), Elem.Items.Add(PropName))
              else
              if IsObject(AnObj.ClassType, cTListItems) then
                ListItemsToXML(TListItems(AnObj), Elem.Items.Add(PropName))
              else
              if IsObject(AnObj.ClassType, cTStrings) then
                StringsToXML(TStrings(AnObj), Elem.Items.Add(PropName))
              else
              if IsObject(AnObj.ClassType, cTCollection) then
                CollectionToXML(TCollection(AnObj), Elem.Items.Add(PropName), Recurse)
              else
              if not IsObject(AnObj.ClassType, cTComponent) then
                // NB! TComponents are excluded because most of the time, a published TComponent
                // property references another component on the form. In some cases, however, a TComponent
                // *can* be an internal component and this code won't list it.
                // No known solution yet (no, HasParent/GetparentComponent doesn't work here)
                InnerComponentToXML(AnObj, Elem.Items.Add(PropName), Recurse);
            end;
        end;
      end;
    end;
    if Recurse and (AComponent is TComponent) then
      for I := 0 to TComponent(AComponent).ComponentCount - 1 do
        if TComponent(AComponent).Components[I].Name <> '' then
          InnerComponentToXML(TComponent(AComponent).Components[I], Elem.Items.Add(TComponent(AComponent).Components[I].Name), True);
  end;
  procedure CollectionToXML(Collection: TCollection; Elem: TJvSimpleXMLElem; Recurse:Boolean);
  var
    I: Integer;
  begin
    if not InSkipList(Collection) then
      for I := 0 to Collection.Count - 1 do
        if not InSkipList(Collection.Items[I]) then
          InnerComponentToXML(Collection.Items[I], Elem.Items.Add(Collection.Items[I].DisplayName), Recurse);
  end;

begin
  Result := '';
  FXML.Root.Clear;
  if AComponent = nil then
    Exit;
  if AComponent is TApplication then
  begin
    AName := TApplication(AComponent).Title;
    FXML.Root.Name := 'Translation'; // DO NOT LOCALIZE
    AElem := FXML.Root.Items.Add(AName);
  end
  else
  begin
    AName := TComponent(AComponent).Name;
    AElem := FXML.Root;
    FXML.Root.Name := AName;
  end;
  if AName <> '' then
  begin
    InnerComponentToXML(AComponent, AElem, Recurse);

    //WIETHAUS - Falta Parametros
    //no enought actual parameter
    //StringStream := TStringStream.Create;
    StringStream := TStringStream.Create('');
    try
      JclStream := TJclStringStream.Create(StringStream);
      try
        FXML.Root.SaveToStringStream(JclStream);
        Result := StringStream.DataString;
      finally
        JclStream.Free;
      end;
    finally
      StringStream.Free;
    end;
  end;
end;

procedure TJvTranslator.Translate(const FileName: string);
begin
  try
    FXML.LoadFromFile(FileName);
    TranslateComponent(Application, FXML.Root);
  except
  end;
end;

procedure TJvTranslator.Translate(const Stream: TStream);
begin
  try
    FXML.LoadFromStream(Stream);
    TranslateComponent(Application, FXML.Root);
  except
  end;
end;

procedure TJvTranslator.TranslateScreen(const FileName: string);
var
  I: Integer;
begin
  try
    FXML.LoadFromFile(FileName);
    for I := 0 to Screen.FormCount - 1 do
      Translate(Screen.Forms[I]);
  except
  end;
end;

procedure TJvTranslator.TranslateScreen(const Stream: TStream);
var
  I: Integer;
begin
  try
    FXML.LoadFromStream(Stream);
    for I := 0 to Screen.FormCount - 1 do
      Translate(Screen.Forms[I]);
  except
  end;
end;

procedure TJvTranslator.Translate(const FileName: string; const Form: TCustomForm);
begin
  try
    FXML.LoadFromFile(FileName);
    Translate(Form);
  except
  end;
end;

procedure TJvTranslator.TranslateComponent(const Component: TComponent;
  const Elem: TJvSimpleXMLElem);
var
  I, J: Integer;
  PropInfo: PPropInfo;
  Obj: TObject;
  Ok: Boolean;
  S: string;

  procedure TransObject(const Obj: TObject; const Elem: TJvSimpleXMLElem); forward;

  function AnalyseCRLF(Value: string): string;
  begin
    Result := StringReplace(Value, cNewline, sLineBreak, [rfReplaceAll]);
  end;

  procedure TransStrings(const Obj: TObject; const Elem: TJvSimpleXMLElem);
  var
    I, J: Integer;
  begin
    if (Elem.Items.Count > 0) and (Elem.Items[0] is TJvSimpleXmlElemCData) then
      TStrings(Obj).Text := Elem.Items[0].Value
    else
      for I := 0 to Elem.Items.Count - 1 do
      begin
        J := Elem.Items[I].Properties.IntValue(cIndex, MaxInt);
        if J < TStrings(Obj).Count then
          TStrings(Obj).Strings[J] := Elem.Items[I].Properties.Value(cValue);
      end;
  end;

  procedure TransTreeNodes(const Obj: TObject; const Elem: TJvSimpleXMLElem);
  var
    I, J: Integer;
  begin
    for I := 0 to Elem.Items.Count - 1 do
    begin
      J := Elem.Items[I].Properties.IntValue(cIndex, MaxInt);
      if J < TTreeNodes(Obj).Count then
        TTreeNodes(Obj).Item[J].Text := Elem.Items[I].Properties.Value(cValue);
    end;
  end;

  procedure TransVars;
  var
    I, J: Integer;
  begin
    with TJvTranslatorStrings(Component) do
      for I := 0 to Elem.Items.Count - 1 do
      begin
        J := TJvTranslatorStrings(Component).IndexOf(Elem.Items[I].Properties.Value(cName));
        if J <> -1 then
          TJvTranslatorStrings(Component).Strings[J] := AnalyseCRLF(Elem.Items[I].Properties.Value(cValue));
      end;
  end;

  procedure TransListItems(const Obj: TObject; const Elem: TJvSimpleXMLElem);
  var
    I, J: Integer;
  begin
    for I := 0 to Elem.Items.Count - 1 do
    begin
      J := Elem.Items[I].Properties.IntValue(cIndex, MaxInt);
      if J < TListItems(Obj).Count then
        with TListItems(Obj).Item[J] do
        begin
          J := Elem.Items[I].Properties.IntValue(cColumn, MaxInt);
          if J = 0 then
            Caption := Elem.Items[I].Properties.Value(cValue)
          else
          begin
            Dec(J);
            if J < SubItems.Count then
              SubItems[J] := Elem.Items[I].Properties.Value(cValue);
          end;
        end;
    end;
  end;

  procedure TransProperties(const Obj: TObject; const Elem: TJvSimpleXMLElem);
  var
    I, J: Integer;
    PropInfo: PPropInfo;
    S: string;
  begin
    if Obj = nil then
      Exit;
    for I := 0 to Elem.Properties.Count - 1 do
    try
      PropInfo := GetPropInfo(Obj, Elem.Properties[I].Name, [tkInteger, tkEnumeration, tkSet] + tkStrings);
      if (PropInfo <> nil) and (PropInfo^.SetProc <> nil) and not InSkipList(Obj, Elem.Properties[I].Name) then
        case PropInfo^.PropType^.Kind of
          {$IFDEF UNICODE} tkUString, {$ENDIF}
          tkString, tkLString, tkWString:
            SetStrProp(Obj, PropInfo, StringReplace(Elem.Properties[I].Value, cNewline, sLineBreak, []));
          tkSet:
            SetSetProp(Obj, PropInfo, Elem.Properties[I].Value);
          tkEnumeration:
            begin
              S := Elem.Properties[I].Value;
              if (StrToIntDef(S, 0) = 0) and (S <> '0') then
              begin
                try
                  J := GetEnumValue(PropInfo.PropType^, S);
                except
                  J := 0;
                end;
              end
              else
                J := StrToIntDef(S, 0);
              SetOrdProp(Obj, PropInfo, J);
            end;
          tkInteger:
            if PropInfo^.Name = 'ShortCut' then
              SetOrdProp(Obj, PropInfo, TextToShortcut(Elem.Properties[I].Value))
            else
              SetOrdProp(Obj, PropInfo, Elem.Properties[I].IntValue);
        end;
    except
    end;
  end;

  procedure TranslateCollection(const Collection: TCollection; const Elem: TJvSimpleXMLElem);
  var
    I, J: Integer;
  begin
    if Obj = nil then
      Exit;
    for I := 0 to Elem.Items.Count - 1 do
    begin
      J := Elem.Items[I].Properties.IntValue(cIndex, -1);
      if J = -1 then
        Continue;
      if J < Collection.Count then
      begin
        TransProperties(Collection.Items[J], Elem.Items[I]);
        TransObject(Collection.Items[J], Elem.Items[I]);
      end;
    end;
  end;

  procedure TransObject(const Obj: TObject; const Elem: TJvSimpleXMLElem);
  var
    I, J: Integer;
    PropInfo: PPropInfo;
    S: string;
    lObj: TObject;
  begin
    if Obj = nil then
      Exit;
    if IsObject(Obj.ClassType, cTCollection) then
      TranslateCollection(TCollection(Obj), Elem)
    else
      for I := 0 to Elem.Items.Count - 1 do
      try
        PropInfo := GetPropInfo(Obj, Elem.Items[I].Name, [tkInteger, tkEnumeration, tkSet] + tkStrings);
        if (PropInfo <> nil) and (PropInfo^.SetProc <> nil) and not InSkipList(Obj, Elem.Items[I].Name) then
          case PropInfo^.PropType^.Kind of
            {$IFDEF UNICODE} tkUString, {$ENDIF}
            tkString, tkLString, tkWString:
              SetStrProp(Obj, PropInfo, StringReplace(Elem.Items[I].Value, cNewline, sLineBreak, []));
            tkSet:
              SetSetProp(Obj, PropInfo, Elem.Items[I].Value);
            tkEnumeration:
              begin
                S := Elem.Items[I].Value;
                if (StrToIntDef(S, 0) = 0) and (S <> '0') then
                begin
                  try
                    J := GetEnumValue(PropInfo.PropType^, S);
                  except
                    J := 0;
                  end;
                end
                else
                  J := StrToIntDef(S, 0);
                SetOrdProp(Obj, PropInfo, J);
              end;
            tkInteger:
              SetOrdProp(Obj, PropInfo, Elem.Items[I].IntValue);
            tkClass:
              begin
                lObj := GetObjectProp(Obj, Elem.Items[I].Name);
                TransProperties(lObj, Elem.Items[I]);
                TransObject(lObj, Elem.Items[I]);
              end;
          end;
      except
      end;
  end;

begin
  if IsObject(Component.ClassType, cTJvTranslatorStrings) then
  begin
    TransVars;
    Exit;
  end;

  try
    //Transform properties
    if not InSkipList(Component) then
      TransProperties(Component, Elem);

    //Transform childs
    with Component do
      for I := 0 to Elem.Items.Count - 1 do
      begin
        Ok := False;
        for J := 0 to ComponentCount - 1 do
        begin
          S := LowerCase(Elem.Items[I].Name);
          if AnsiSameText(Components[J].Name, S) then
          begin
            TranslateComponent(Components[J], Elem.Items[I]);
            Ok := True;
            Break;
          end;
        end;
        if not Ok then
        begin
          PropInfo := GetPropInfo(Component, Elem.Items[I].Name, [tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
            tkSet, tkClass, tkMethod, tkWChar, tkVariant, tkArray, tkRecord,
            tkInterface, tkInt64, tkDynArray] + tkStrings);
          if (PropInfo <> nil) and (PropInfo^.SetProc <> nil) and not InSkipList(Component, Elem.Items[I].Name) then
          begin
            Obj := GetObjectProp(Component, Elem.Items[I].Name);
            if IsObject(Obj.ClassType, cTStrings) then
              TransStrings(Obj, Elem.Items[I])
            else
            if IsObject(Obj.ClassType, cTTreeNodes) then
              TransTreeNodes(Obj, Elem.Items[I])
            else
            if IsObject(Obj.ClassType, cTListItems) then
              TransListItems(Obj, Elem.Items[I])
            else
            begin
              TransProperties(Obj, Elem.Items[I]);
              TransObject(Obj, Elem.Items[I]);
            end;
          end;
        end;
      end;
  except
  end;
end;

procedure TJvTranslator.Translate(const Form: TCustomForm);
var
  J: Integer;
  S: string;
  lElem: TJvSimpleXMLElem;
begin
  J := Pos('_', Form.Name);
  if J = 0 then
    S := Form.Name
  else
    S := Copy(Form.Name, 1, J - 1);
  lElem := FindItemNamed(nil, S, True);
  if lElem <> nil then
    TranslateComponent(Form, lElem)
end;

function TJvTranslator.Translate(const Category, Item: string): string;
var
  lElem: TJvSimpleXMLElem;
begin
  Result := '';
  lElem := FindItemNamed(nil, Category, True);
  if lElem <> nil then
  begin
    lElem := FindItemNamed(lElem, Item, True);
    if lElem <> nil then
    begin
      Result := lElem.Value;
      if Result = '' then
        Result := lElem.Properties.Value(cValue);
    end;
  end;
end;

procedure TJvTranslator.SkipClass(AClass: TClass);
begin
  SkipProperty(AClass, '');
end;

procedure TJvTranslator.UnskipClass(AClass: TClass);
begin
  UnskipProperty(AClass, '');
end;

function TJvTranslator.InSkipList(AClass: TClass): Boolean;
begin
  Result := InSkipList(AClass, '');
end;

function TJvTranslator.InSkipList(Obj: TObject): Boolean;
begin
  if Obj = nil then
    Result := InSkipList(TObject(nil))
  else
    Result := InSkipList(Obj.ClassType);
end;

function TJvTranslator.InSkipList(Obj: TObject; const PropName: string): Boolean;
begin
  if Obj = nil then
    Result := InSkipList(TObject(nil), PropName)
  else
    Result := InSkipList(Obj.ClassType, PropName);
end;

function TJvTranslator.InSkipList(AClass: TClass; const PropName: string): Boolean;
var
  I: Integer;
  P: PSkipPropRec;
begin
  Result := False;
  if FSkipList <> nil then
    for I := 0 to FSkipList.Count - 1 do
    begin
      P := PSkipPropRec(FSkipList[I]);
      if (P^.AClass = AClass) or AClass.InheritsFrom(P^.AClass) then
      begin
        if ((PropName = '') and (P^.AProps.Count = 0)) or (P^.AProps.IndexOf(PropName) > -1) then
        begin
          Result := True;
          if PropName = '' then
            // move item to beginning of list since it is very likely that we want to access this class very soon
            FSkipList.Move(I, 0);
          Break;
        end;
      end;
    end;
end;

procedure TJvTranslator.Translate(const Stream: TStream; const Form: TCustomForm);
begin
  FXML.LoadFromStream(Stream);
  Translate(Form);
end;

procedure TJvTranslator.TranslateString(const S: string);
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create(S);
  try
    Translate(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TJvTranslator.TranslateString(const S: string; const Form: TCustomForm);
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create(S);
  try
    Translate(Stream, Form);
  finally
    Stream.Free;
  end;
end;

procedure TJvTranslator.TranslateScreenString(const S: string);
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create(S);
  try
    TranslateScreen(Stream);
  finally
    Stream.Free;
  end;
end;

//=== { TJvTranslatorStrings } ===============================================

constructor TJvTranslatorStrings.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FList := THashedStringList.Create;
end;

destructor TJvTranslatorStrings.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

function TJvTranslatorStrings.Add(const Name: string; var Value: string): Integer;
begin
  // (rom) AddObject? Strange.
  Result := FList.AddObject(Name, TObject(@Value));
end;

function TJvTranslatorStrings.GetString(Index: Integer): string;
begin
  Result := FList[Index];
end;

function TJvTranslatorStrings.IndexOf(const Name: string): Integer;
begin
  Result := FList.IndexOf(Name);
end;

procedure TJvTranslatorStrings.SetString(Index: Integer; const Value: string);
begin
  PString(FList.Objects[Index])^ := Value;
end;

function TJvTranslatorStrings.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TJvTranslatorStrings.GetValue(Index: Integer): string;
begin
  if (Index >= 0) and (Index < Count) and (FList.Objects[Index] <> nil) then
    Result := PString(FList.Objects[Index])^
  else
    Result := '';
end;

procedure TJvTranslator.SkipProperty(AClass: TClass; const PropName: string);
var
  I: Integer;
  P: PSkipPropRec;
begin
  if FSkipList = nil then
    FSkipList := TList.Create;
  for I := 0 to FSkipList.Count - 1 do
    if PSkipPropRec(FSkipList[I])^.AClass = AClass then
    begin
      P := PSkipPropRec(FSkipList[I]);
      if PropName = '' then
        P^.AProps.Clear // skip entire class
      else
      if P^.AProps.Count > 0 then // only add if the class is not skipped as a whole
        P^.AProps.Add(PropName); // the list is sorted, so property name will only be added once
      Exit;
    end;
  // class not found, so add new class record to list
  New(P);
  P^.AClass := AClass;
  P^.AProps := TStringList.Create;
  P^.AProps.Sorted := True;
  if PropName <> '' then
    P^.AProps.Add(PropName); // skip this property only
  FSkipList.Add(P);
  if AClass.InheritsFrom(TPersistent) then
    Classes.RegisterClass(TPersistentClass(AClass));
end;

procedure TJvTranslator.UnskipProperty(AClass: TClass; const PropName: string);
var
  I, J: Integer;
  P: PSkipPropRec;
begin
  if FSkipList <> nil then
  begin
    for I := 0 to FSkipList.Count - 1 do
      if PSkipPropRec(FSkipList[I])^.AClass = AClass then
      begin
        P := PSkipPropRec(FSkipList[I]);
        if PropName <> '' then
          J := P^.AProps.IndexOf(PropName)
        else
        begin
          J := -1;
          P^.AProps.Clear;
        end;
        if J > -1 then
          P^.AProps.Delete(J);
        if P^.AProps.Count = 0 then
          // remove the entry when there are no properties skipped or if this is a UnskipClass call
        begin
          P^.AProps.Free;
          FSkipList.Delete(I);
          Dispose(P);
        end;
        if FSkipList.Count = 0 then
          FreeAndNil(FSkipList);
        Break;
      end;
  end;
end;

procedure TJvTranslator.ClearSkipList;
var
  I: Integer;
begin
  if FSkipList <> nil then
  begin
    for I := 0 to FSkipList.Count - 1 do
    begin
      PSkipPropRec(FSkipList[I]).AProps.Free;
      Dispose(PSkipPropRec(FSkipList[I]));
    end;
    FreeAndNil(FSkipList);
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.