{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2007 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecLocalizer226;

interface

uses Windows, Classes, Controls, TypInfo, Graphics;

type

  TecLocalizer = class(TComponent)
  private
    FEnabled: Boolean;
    FProperties: TStrings;
    FClasses: TStringList;
    FCharset: TFontCharSet;
    procedure SetProperties(const Value: TStrings);
    procedure ClearCls;
    procedure PropLstChanged(Sender: TObject);
    procedure SetObjCharset(Obj: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function LocalizeObject(Obj: TObject): Boolean;
  published
    property Enabled: Boolean read FEnabled write FEnabled default True;
    property Properties: TStrings read FProperties write SetProperties;
    property Charset: TFontCharSet read FCharset write FCharset default DEFAULT_CHARSET;
  end;

// Function that is called from dialogs to localize themself.
function LocalizeObject(Obj: TObject): Boolean;
// For design time editor
procedure AddLocalizableProps(Obj: TObject; List: TStrings);

procedure Register;

implementation

uses SysUtils, IniFiles, Registry, Forms,
     Contnrs{$IFDEF EC_DOTNET}, Variants{$ENDIF};

var
 ecLocalizers: TList = nil;

procedure Register;
begin
  RegisterComponents('EC SyntEdit', [TecLocalizer]);
end;

function TypeKind(pInfo: PPropInfo): TTypeKind;
begin
 Result := pInfo{$IFNDEF EC_DOTNET}^{$ENDIF}.PropType{$IFNDEF EC_DOTNET}^^{$ENDIF}.Kind;
end;

function GetObjProp(Source: TObject; const Prop: string): TObject;
var pInfo: PPropInfo;
    k, Index: integer;
    PN: string;
begin
 Result := nil;
 if Source <> nil then
 try
   // Check for collection item
   PN := Prop;
   k := Pos('[', Prop);
   if k > 0 then
    begin
     Index := StrToInt(Copy(Prop, k + 1, Length(Prop) - k - 1));
     PN := Copy(Prop, 1, k - 1);
    end else Index := -1;

   PInfo := GetPropInfo(Source, PN, [tkClass]);
   if (pInfo <> nil) and (TypeKind(pInfo) = tkClass) then
    begin
      Result := TObject(GetOrdProp(Source, PN));
      if (Index >= 0) and (Result <> nil) then
       if (Result is TCollection) and ((Result as TCollection).Count > Index) then
         Result := (Result as TCollection).Items[Index]
       else
         Result := nil;
    end else Result := nil;
 except
 end
end;

function ExtractObject(Source: TObject; Root: TComponent; var Path: string; WithProp: Boolean): TObject;
var k: integer;
    S: string;
    IsFirst: Boolean;

  function GetObj(const Prop: string): TObject;
  var k, k1, Index: integer;
  begin
   k := Pos('[', Prop);
   k1 := Pos(']', Prop);
   if (k > 0) and (k1 > k) then // Collection item handling
    begin
     Result := GetObjProp(Source, Copy(Prop, 1, k - 1));
     if (Result <> nil) and (Result is TCollection) then
      begin
       Index := StrToInt(Trim(Copy(Prop, k + 1, k1 - k - 1)));
       if (Index >= 0) and (Index < TCollection(Result).Count) then
        Result := TCollection(Result).Items[Index]
       else
        Result := nil;
      end else Result := nil;
     Exit;
    end;

   Result := GetObjProp(Source, Prop);
   if Result = nil then
    begin
      if SameText(Prop, 'Owner') and (Source is TComponent) then
        Result := (Source as TComponent).Owner else
      if IsFirst and (Root <> nil) then
        Result := Root.FindComponent(Prop);
      if (Result = nil) and (Source <> nil) and (Source is TComponent) then
        Result := (Source as TComponent).FindComponent(Prop);
    end;
  end;

begin
  IsFirst := True;
  k := Pos('.', Path);
  while k > 0 do
   begin
     S := Copy(Path, 1, k - 1);
     Result := GetObj(Copy(Path, 1, k - 1));
     if Result = nil then  Exit;
     IsFirst := False;
     Source := Result;
     Path := Copy(Path, k + 1, Length(Path) - k);
     k := Pos('.', Path);
   end;
  if (Path = '') or (WithProp and (Pos('[', Path) = 0)) then Result := Source
   else
    begin
     Result := GetObj(Path);
     if Result = nil then Result := Source
      else Path := '';
    end;
end;

procedure AddLocalizableProps(Obj: TObject; List: TStrings);
var Base: string;

  procedure GetStringProps(AObj: TObject; const BaseName: string);
  var PList: PPropList;
      i, j, Count: integer;
      PN, S: string;
      _sl: TObject;
  begin
    {$IFNDEF EC_DOTNET}
     PList := nil;
     Count := GetPropList(PTypeInfo(AObj.ClassInfo), [tkLString, tkClass], PList);
     if Count = 0 then Exit;
     GetMem(PList, Count * sizeof(Pointer));
     GetPropList(PTypeInfo(AObj.ClassInfo), [tkLString, tkClass], PList);
    {$ELSE}
     PList := GetPropList(AObj);
     Count := Length(PList);
    {$ENDIF}
    try
      for i := 0 to Count - 1 do
       begin
        {$IFNDEF EC_DOTNET}
         PN := PList^[i]^.Name;
        {$ELSE}
         PN := PList[i].Name;
        {$ENDIF}
         S := '';
         case PropType(AObj, PN) of
           tkLString: S := GetPropValue(AObj, PN);
           tkClass:
             begin
               _sl := TObject(GetOrdProp(AObj, PList{$IFNDEF EC_DOTNET}^{$ENDIF}[i]));
               PN := PN + '.Text';
               if (_sl <> nil) and (_sl is TStrings) then
                begin
                  with _sl as TStrings do
                   for j := 0 to Count - 1 do
                    begin
                      if j > 0 then S := S + '|';
                      S := S + Strings[j];
                    end;
                end;
             end;
         end;
         if (S <> '') and not (PN = 'Name') then
           List.Add(BaseName + PN + '=' + S);
       end;
    finally
      {$IFNDEF EC_DOTNET}
      FreeMem(PList);
      {$ENDIF}
    end;
  end;

  procedure AddComponents(Root: TComponent; BaseName: string);
  var i: integer;
      cmp: TComponent;
  begin
    for i := 0 to Root.ComponentCount - 1 do
     begin
       cmp := Root.Components[i];
       if cmp.Name <> '' then
        begin
         GetStringProps(cmp, BaseName + cmp.Name + '.');
         if cmp is TFrame then
           AddComponents(cmp, BaseName + cmp.Name + '.');
        end;
    end;
  end;
begin
  List.Add('[' + Obj.ClassName + ']');
  Base := Obj.ClassName + '.';
  GetStringProps(Obj, Base);
  if obj is TComponent then
   AddComponents(obj as TComponent, Base);
end;


{ TecLocalizer }

constructor TecLocalizer.Create(AOwner: TComponent);
begin
  inherited;
  if not Assigned(ecLocalizers) then
    ecLocalizers := TList.Create;
  ecLocalizers.Add(Self);
  FClasses := TStringList.Create;
  FClasses.Sorted := True;
  FProperties := TStringList.Create;
  TStringList(FProperties).OnChange := PropLstChanged;
  FEnabled := True;
  FCharset := DEFAULT_CHARSET;
end;

destructor TecLocalizer.Destroy;
begin
  ecLocalizers.Remove(Self);
  if ecLocalizers.Count = 0 then
   begin
     ecLocalizers.Free;
     ecLocalizers := nil;
   end;
  FProperties.Free;
  ClearCls;
  FClasses.Free;
  inherited;
end;

procedure TecLocalizer.ClearCls;
var i: integer;
begin
  for i := 0 to FClasses.Count - 1 do
    FClasses.Objects[i].Free;
  FClasses.Clear;
end;

procedure TecLocalizer.SetProperties(const Value: TStrings);
begin
  FProperties.Assign(Value);
end;

procedure TecLocalizer.PropLstChanged(Sender: TObject);
var i, k: integer;
    S, CN: string;
begin
  ClearCls;
  for i := 0 to FProperties.Count - 1 do
   begin
    S := FProperties[i];
    k := Pos('.', S);
    if (k > 1) and (S[1] in ['a'..'z','A'..'Z','_']) then
     begin
       CN := UpperCase(Copy(S, 1, k - 1));
       Delete(S, 1, k);
       k := FClasses.IndexOf(CN);
       if k = -1 then
         k := FClasses.AddObject(CN, TStringList.Create);
       TStringList(FClasses.Objects[k]).Add(S);
     end;
   end;
end;

type TControlHack = class(TControl);

procedure TecLocalizer.SetObjCharset(Obj: TObject);
 procedure UpdateControl(Control: TControl);
 var i: integer;
 begin
  TControlHack(Control).Font.Charset := FCharset;
  if Control is TWinControl then
   with Control as TWinControl do
    for i := 0 to ControlCount - 1 do
     UpdateControl(Controls[i]);
 end;
begin
  if Obj is TControl then
   UpdateControl(Obj as TControl);
end;

function TecLocalizer.LocalizeObject(Obj: TObject): Boolean;
var i, k: integer;
    S, CN, v: string;
    Root: TComponent;
    Dest: TObject;
    dst_str, FProps: TStrings;
begin
 Result := False;

 if Obj is TComponent then Root := TComponent(Obj)
  else Root := nil;

 if Root <> nil then
  for i := 0 to Root.ComponentCount - 1 do
   if FClasses.IndexOf(UpperCase(Root.Components[i].ClassName))<> -1 then
    LocalizeObject(Root.Components[i]);

 CN := UpperCase(Obj.ClassName);
 k := FClasses.IndexOf(CN);
 if k = -1 then Exit;
 FProps := TStrings(FClasses.Objects[k]);

 SetObjCharset(Obj);

 for i := 0 to FProps.Count - 1 do
  begin
   S := FProps[i];
   k := Pos('=', S);
   if k > 1 then
     begin
       V := Copy(S, k + 1, Length(S) - k);
       Delete(S, k, Length(S));
       Dest := ExtractObject(Obj, Root, S, True);
       if Dest <> nil then
        try
          if Dest is TStrings then
          begin
           dst_str := Dest as TStrings;
           dst_str.BeginUpdate;
           dst_str.Clear;
           try
            repeat
             k := Pos('|', V);
             if k > 0 then
              begin
                dst_str.Add(Copy(V, 1, k - 1));
                Delete(V, 1, k);
              end;
            until k = 0;
            if V <> '' then dst_str.Add(V);
           finally
             dst_str.EndUpdate;
           end;
          end
          else SetPropValue(Dest, S, V);
          Result := True;
        except
        end;
     end;
  end;
end;

function LocalizeObject(Obj: TObject): Boolean;
var i: integer;
begin
  Result := False;
  if Assigned(ecLocalizers) then
   for i := 0 to ecLocalizers.Count - 1 do
    if TecLocalizer(ecLocalizers[i]).Enabled then
     Result := Result or TecLocalizer(ecLocalizers[i]).LocalizeObject(Obj);
end;

end.

