jvqtranslator.pas

East make Tray Icon in delphi

                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 := PropInfo^.Name;
        try
          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));
            tkString, tkLString, tkWString:
              Elem.Properties.Add(PropName, XMLEncode(InternalGetWideStrProp(AComponent, PropName)));
            tkClass:
              begin
                AnObj := GetObjectProp(AComponent, 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), 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;
        except
          //
        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);
    Result := FXML.Root.SaveToString;
  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, tkString, tkLString, tkWString]);
      if (PropInfo <> nil) and (PropInfo^.SetProc <> nil) and not InSkipList(Obj, Elem.Properties[I].Name) then
        case PropInfo^.PropType^.Kind of
          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, tkString, tkLString, tkClass]);
        if (PropInfo <> nil) and (PropInfo^.SetProc <> nil) and not InSkipList(Obj, Elem.Items[I].Name) then
          case PropInfo^.PropType^.Kind of
            tkString, tkLString:
              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);