{==============================================================================

  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsConvert;

{$I KsCommonVer.Inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, Menus, StdCtrls;

type

  TClassKind = (ckCheckBox, ckRadioButton, ckTrackBar, ckGroupBox, ckRadioGroup,
    ckScrollBar, ckListBox, ckEdit, ckComboBox, ckSpeedButton, ckSpinButton,
    ckButton, ckProgressBar, ckCustomForm, ckEngine, ckTabControl, ckPageControl,
    ckLast);

  TConvertEvent = procedure (Sender: TObject; Max, Position: integer) of object;

  TKsCustomConverter = class(TComponent)
  private
    FRules: TStrings;
    FLog: TStrings;
    FOnProgress: TConvertEvent;
    function GetRules(Kind: TClassKind): string;
    procedure SetRules(Kind: TClassKind; const Value: string);
    procedure SetLog(const Value: TStrings);
    procedure SetOnProgress(const Value: TConvertEvent);
  protected
    FForm: TCustomForm;
    procedure InsertToLog(Line: string);
    procedure Progress(Max, Pos: integer);

    procedure BuildRules;
    procedure CopyExistsProperties(Source, Dest: TObject);
    procedure CopyPropertyValue(Source, Dest: TObject; APropName: string);
    procedure SetPropertyIfExists(AComp: Tcomponent; APropName: string; Value: TObject);
    function CreateCopy(AComp: TComponent; Kind: TClassKind): TComponent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function GetClass(ClassKind: TClassKind): TComponentClass; virtual;
    procedure SetAdvancedProp(AOldObject, ANewObject: TObject); virtual;

    procedure ConvertForm(Form: TCustomForm);
    property Rules[Kind: TClassKind]: string read GetRules write SetRules;

    property Log: TStrings read FLog write SetLog;
    property OnProgress: TConvertEvent read FOnProgress write SetOnProgress;
  end;

  TKsConverterClass = class of TKsCustomConverter;

{ Rules list routines }

function GetClassCount(Rules: string): integer;
function GetClassName(Rules: string; Index: integer): string;
procedure AddClassName(var Rules: string; NewClassName: string);
function AddClassName2(Rules: string; NewClassName: string): string;

implementation {===============================================================}

uses TypInfo, Dialogs, KsButtons, KsEdits, KsGroupBoxs;

type

  THackControl = class(TControl);

function GetToken(var S: string): string;
var
  i: integer;
begin
  Result := '';

  S := Trim(S);

  for i := 1 to Length(S) do
  begin
    if S[i] in [';',':','='] then Break;
    Result := Result + S[i];
  end;

  Delete(S, 1, Length(Result)+1);

  Result := Trim(Result);

  S := Trim(S);
end;

function GetClassCount(Rules: string): integer;
begin
  Result := 0;
  while Rules <> '' do
  begin
    GetToken(Rules);
    Inc(Result);
  end;
end;

function GetClassName(Rules: string; Index: integer): string;
var
  Token: string;
  i: integer;
begin
  i := 0;
  while Rules <> '' do
  begin
    Token := GetToken(Rules);
    if i = Index then
    begin
      Result := Token;
      Exit;
    end;
    Inc(i);
  end;
  Result := '';
end;

procedure AddClassName(var Rules: string; NewClassName: string);
begin
  if (Rules <> '') and (Rules[Length(Rules)] <> ';') then
    Rules := Rules + ';';

  Rules := Rules + NewClassName;
end;

function AddClassName2(Rules: string; NewClassName: string): string;
begin
  if (Rules <> '') and (Rules[Length(Rules)] <> ';') then
    Rules := Rules + ';';

  Result := Rules + NewClassName;
end;

{ TKsCustomConverter ==========================================================}

constructor TKsCustomConverter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FRules := TStringList.Create;

  BuildRules;
end;

destructor TKsCustomConverter.Destroy;
begin
  FRules.Free;
  inherited Destroy;
end;

procedure TKsCustomConverter.BuildRules;
begin
  Rules[ckButton] := 'TButton;TBitBtn;TRzButton';
  Rules[ckCheckBox] := 'TCheckBox;TRzCheckBox';
  Rules[ckRadioButton] := 'TRadioButton;TRzRadioButton';
  Rules[ckTrackBar] := 'TTackBar;TRxSlider;TRzTrackBar';
  Rules[ckGroupBox] := 'TGroupBox;TRzGroupBox';
  Rules[ckRadioGroup] := 'TRadioGroup;TRzRadioGroup';
  Rules[ckScrollBar] := 'TScrollBar;';
  Rules[ckListBox] := 'TListBox;TCheckListBox;TRzListBox;TRzCheckList';
  Rules[ckEdit] := 'TEdit;TMaskEdit;TRzEdit';
  Rules[ckComboBox] := 'TComboBox;TRzComboBox';
  Rules[ckSpeedButton] := 'TSpeedButton;TToolButton;TRxSpeedButton;TRzToolbarButton';
  Rules[ckSpinButton] := 'TSpinButton;TUpDown;TRxSpinButton';
  Rules[ckProgressBar] := 'TGauge;TProgressBar;TRzProgressBar';
{  Rules[ckTabControl]
  Rules[ckPageControl]}
end;

procedure TKsCustomConverter.ConvertForm(Form: TCustomForm);
var
  i, r, c: integer;
  Comp, NewComp: TComponent;
  ClassList: string;
begin
  if Form = nil then Exit;
  FForm := Form;

  if FLog <> nil then FLog.Clear;

  InsertToLog(Format('Convertion "%s" form, please wait...', [Form.Name]));
  InsertToLog('');
  { Call OnProgress }
  Progress(Form.ComponentCount, 0);
  { Convert form }
  for i := 0 to Form.ComponentCount - 1 do
  begin
    Comp := Form.Components[i];
    { Search in Rules  }
    for r := 0 to Integer(ckLast) - 1 do
    begin
      ClassList := Rules[TClassKind(r)];

      NewComp := nil;

      for c := 0 to GetClassCount(ClassList) - 1 do
        if LowerCase(Comp.ClassName) = LowerCase(GetClassName(ClassList, c)) then
        begin
          { Crete New Component }
          try
            NewComp := CreateCopy(Comp, TClassKind(r));
          except
            InsertToLog('!!! Convertion error : '+Comp.Name);
          end;
          Break;
        end;

      if NewComp <> nil then Break;
    end;
    { Call OnProgress }
    Progress(Form.ComponentCount, i);
  end;
  Progress(Form.ComponentCount, Form.ComponentCount);

  InsertToLog('Convertion complete!');
end;

function TKsCustomConverter.CreateCopy(AComp: TComponent; Kind: TClassKind): TComponent;
var
  OldName: string;
  CompClass: TComponentClass;
  CompIndex: integer;
begin
  CompClass := GetClass(Kind);

  if CompClass <> nil then
  begin
    { Save and change name }
    OldName := AComp.Name;
    CompIndex := AComp.ComponentIndex;
    { Create new }
    Result := CompClass.Create(AComp.Owner);
    Result.Name := OldName+'_T';
    Result.ComponentIndex := CompIndex;
    InsertToLog(Format('Create copy of "%s" component.', [Result.Name]));
    { Set Control property }
    if AComp is TControl then
    begin
      TControl(Result).Parent := TControl(AComp).Parent;
    end;
    { Copy properties }
    InsertToLog(Format('Copy "%s"''s properties.', [Result.Name]));
    try
      CopyExistsProperties(AComp, Result);
    except
      InsertToLog('!!! Properties convertion error : '+AComp.Name);
    end;
    { Set Advanced Properties }
    SetAdvancedProp(AComp, Result);
    { Delete old }
    AComp.Free;
    { Rename }
    Result.Name := OldName;
  end;
  InsertToLog('');
end;

{ Virtual }

function TKsCustomConverter.GetClass(ClassKind: TClassKind): TComponentClass;
begin
  case ClassKind of
    ckButton: Result := TKsCustomButton;
    ckEdit: Result := TKsCustomEdit;
    ckGroupBox: Result := TKsCustomGroupBox;
  else
    Result := nil;
  end;
end;

procedure TKsCustomConverter.SetAdvancedProp(AOldObject, ANewObject: TObject);
var
  i: integer;
  Control: TControl;
begin
  { Set Parent on children controls }
  if (FForm <> nil) and (AOldObject is TWinControl) and (csAcceptsControls in (AOldObject as TWinControl).ControlStyle) then
  begin
    for i := 0 to FForm.ComponentCount - 1 do
      if FForm.Components[i] is TControl then
      begin
        Control := FForm.Components[i] as TControl;
        if Control.Parent = (AOldObject as TControl) then
          THackControl(Control).SetParent(ANewObject as TWinControl);
      end;
  end;
  { For Button }
  if (ANewObject is TKsCustomButton) and (AOldObject is TWinControl) then
  begin
    (ANewObject as TKsCustomButton).Caption := THackControl(AOldObject).Caption;
  end;
end;

{ Internal routines }

procedure TKsCustomConverter.CopyPropertyValue(Source, Dest: TObject; APropName: string);
var
  SourcePropInfo: PPropInfo;
  DestPropInfo: PPropInfo;
  SourceObjectProp, DestObjectProp: TObject;
  SetPropValue: string;
begin
  { Copy property PropName value from source to dest }
  SourcePropInfo := GetPropInfo(Source.ClassInfo, APropName);
  if SourcePropInfo = nil then Exit;

  DestPropInfo := GetPropInfo(Dest.ClassInfo, APropName);
  if DestPropInfo = nil then Exit;

  if Dest is TComponent then
    InsertToLog(Format('  Copy "%s.%s" property.', [TComponent(Dest).Name, APropName]));

  { Copy }
  if SourcePropInfo^.PropType^.Kind = DestPropInfo^.PropType^.Kind then
  begin
    case SourcePropInfo^.PropType^.Kind of
      tkInteger, tkChar: SetOrdProp(Dest, DestPropInfo, GetOrdProp(Source, SourcePropInfo));
      tkFloat: SetFloatProp(Dest, DestPropInfo, GetFloatProp(Source, SourcePropInfo));
      tkString, tkWString, tkWChar, tkLString: SetStrProp(Dest, DestPropInfo, GetStrProp(Source, SourcePropInfo));
      {$IFNDEF KS_COMPILER4}
      tkEnumeration: SetEnumProp(Dest, DestPropInfo, GetEnumProp(Source, SourcePropInfo));
      tkSet: begin
        SetPropValue := '['+GetSetProp(Source, SourcePropInfo)+']';
        SetSetProp(Dest, DestPropInfo, SetPropValue);
      end;
      tkClass: begin
        SourceObjectProp := GetObjectProp(Source, SourcePropInfo);
        DestObjectProp := GetObjectProp(Dest, DestPropInfo);

        if (SourceObjectProp is TPersistent) and not (SourceObjectProp is TComponent) then
          TPersistent(DestObjectProp).Assign(TPersistent(SourceObjectProp))
        else
          SetObjectProp(Dest, DestPropInfo, SourceObjectProp);
      end;
      {$ELSE}
      tkClass: begin
        SourceObjectProp := TObject(GetOrdProp(Source, SourcePropInfo));
        DestObjectProp := TObject(GetOrdProp(Dest, DestPropInfo));

        if (SourceObjectProp is TPersistent) and not (SourceObjectProp is TComponent) then
          TPersistent(DestObjectProp).Assign(TPersistent(SourceObjectProp))
        else
          SetOrdProp(Dest, DestPropInfo, Integer(SourceObjectProp));
      end;
      {$ENDIF}
      tkMethod: SetMethodProp(Dest, DestPropInfo, GetMethodProp(Source, SourcePropInfo));
    end;
  end;
end;

procedure TKsCustomConverter.CopyExistsProperties(Source, Dest: TObject);
var
  PropList: PPropList;
  ClassTypeInfo: PTypeInfo;
  ClassTypeData: PTypeData;
  i: integer;
begin
  if (Source = nil) or (Dest = nil) then Exit;

  ClassTypeInfo := Dest.ClassInfo;
  ClassTypeData := GetTypeData(ClassTypeInfo);

  if ClassTypeData.PropCount <> 0 then
  begin
    { allocate the memory needed to hold the references to the TPropInfo }
    { structures on the number of properties. }
    GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
    try
      { fill PropList with the pointer references to the TPropInfo structures }
      GetPropInfos(Dest.ClassInfo, PropList);
      for i := 0 to ClassTypeData.PropCount - 1 do
      begin
        if LowerCase(PropList[i]^.Name) = 'name' then Continue;
        { Copy property's value }
        CopyPropertyValue(Source, Dest, PropList[i]^.Name);
      end;
    finally
      FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
    end;
  end;
end;

procedure TKsCustomConverter.SetPropertyIfExists(AComp: Tcomponent;
  APropName: string; Value: TObject);
var
  PropInfo: PPropInfo;
begin
  PropInfo := GetPropInfo(AComp.ClassInfo, APropName);
  if PropInfo = nil then Exit;

  SetOrdProp(AComp, PropInfo, Integer(Value));
end;

procedure TKsCustomConverter.InsertToLog(Line: string);
begin
  if FLog <> nil then
    FLog.Add(Line);
end;

procedure TKsCustomConverter.Progress(Max, Pos: integer);
begin
  if Assigned(FOnProgress) then
  begin
    FOnProgress(Self, Max, Pos);
    Application.ProcessMessages;
  end;
end;

{ Properties }

function TKsCustomConverter.GetRules(Kind: TClassKind): string;
begin
  Result := FRules.Values['Ident'+IntToStr(Integer(Kind))];
end;

procedure TKsCustomConverter.SetRules(Kind: TClassKind; const Value: string);
begin
  FRules.Values['Ident'+IntToStr(Integer(Kind))] := Value;
end;

procedure TKsCustomConverter.SetLog(const Value: TStrings);
begin
  FLog := Value;
end;

procedure TKsCustomConverter.SetOnProgress(const Value: TConvertEvent);
begin
  FOnProgress := Value;
end;

end.
