{******************************************}
{                                          }
{             FastScript v1.9              }
{                 ExtCtrls                 }
{                                          }
{  (c) 2003-2007 by Alexander Tzyganenko,  }
{             Fast Reports Inc             }
{                                          }
{******************************************}

unit fs_iextctrlsrtti;

interface

{$i fs.inc}

uses SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iformsrtti
{$IFDEF DELPHI16}
, System.Types
{$ENDIF}
{$IFDEF CLX}
, QExtCtrls, QButtons, QCheckLst, QComCtrls
{$ELSE}
, ExtCtrls, Buttons, CheckLst, ComCtrls
{$ENDIF}
{$IFDEF DELPHI16}, Controls{$ENDIF};

type
{$i frxPlatformsAttribute.inc}
  TfsExtCtrlsRTTI = class(TComponent); // fake component


implementation

type
  TFunctions = class(TfsRTTIModule)
  private
    function CallMethod(Instance: TObject; ClassType: TClass;
      const MethodName: String; Caller: TfsMethodHelper): Variant;
    function GetProp(Instance: TObject; ClassType: TClass;
      const PropName: String): Variant;
    procedure SetProp(Instance: TObject; ClassType: TClass;
      const PropName: String; Value: Variant);
  public
    constructor Create(AScript: TfsScript); override;
  end;


{ TFunctions }

constructor TFunctions.Create(AScript: TfsScript);
begin
  inherited Create(AScript);
  with AScript do
  begin
    AddEnum('TShapeType', 'stRectangle, stSquare, stRoundRect, stRoundSquare,' +
      'stEllipse, stCircle');
    AddEnum('TBevelStyle', 'bsLowered, bsRaised');
    AddEnum('TBevelShape', 'bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine,' +
      'bsRightLine, bsSpacer');
    AddEnum('TResizeStyle', 'rsNone, rsLine, rsUpdate, rsPattern');
    AddEnum('TButtonLayout', 'blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom');
    AddEnum('TButtonState', 'bsUp, bsDisabled, bsDown, bsExclusive');
    AddEnum('TButtonStyle', 'bsAutoDetect, bsWin31, bsNew');
    AddEnum('TBitBtnKind', 'bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,' +
      'bkClose, bkAbort, bkRetry, bkIgnore, bkAll');
    AddType('TNumGlyphs', fvtInt);
    AddEnum('TTabPosition', 'tpTop, tpBottom, tpLeft, tpRight');
    AddEnum('TTabStyle', 'tsTabs, tsButtons, tsFlatButtons');
    AddEnum('TStatusPanelStyle', 'psText, psOwnerDraw');
    AddEnum('TStatusPanelBevel', 'pbNone, pbLowered, pbRaised');
    AddEnum('TSortType', 'stNone, stData, stText, stBoth');
    AddEnum('TTrackBarOrientation', 'trHorizontal, trVertical');
    AddEnum('TTickMark', 'tmBottomRight, tmTopLeft, tmBoth');
    AddEnum('TTickStyle', 'tsNone, tsAuto, tsManual');
    AddEnum('TProgressBarOrientation', 'pbHorizontal, pbVertical');
    AddEnum('TIconArrangement', 'iaTop, iaLeft');
    AddEnum('TListArrangement', 'arAlignBottom, arAlignLeft, arAlignRight,' +
      'arAlignTop, arDefault, arSnapToGrid');
    AddEnum('TViewStyle', 'vsIcon, vsSmallIcon, vsList, vsReport');
    AddEnum('TToolButtonStyle', 'tbsButton, tbsCheck, tbsDropDown, tbsSeparator, tbsDivider');
    AddEnum('TDateTimeKind', 'dtkDate, dtkTime');
    AddEnum('TDTDateMode', 'dmComboBox, dmUpDown');
    AddEnum('TDTDateFormat', 'dfShort, dfLong');
    AddEnum('TDTCalAlignment', 'dtaLeft, dtaRight');
    AddEnum('TCalDayOfWeek', 'dowMonday, dowTuesday, dowWednesday, dowThursday,' +
      'dowFriday, dowSaturday, dowSunday, dowLocaleDefault');

    AddClass(TShape, 'TGraphicControl');
    with AddClass(TPaintBox, 'TGraphicControl') do
      AddEvent('OnPaint', TfsNotifyEvent);
    AddClass(TImage, 'TGraphicControl');
    AddClass(TBevel, 'TGraphicControl');
    with AddClass(TTimer, 'TComponent') do
      AddEvent('OnTimer', TfsNotifyEvent);
    AddClass(TPanel, 'TCustomControl');
    AddClass(TSplitter, 'TGraphicControl');
    AddClass(TBitBtn, 'TButton');
    AddClass(TSpeedButton, 'TGraphicControl');
    with AddClass(TCheckListBox, 'TCustomListBox') do
      AddIndexProperty('Checked', 'Integer', 'Boolean', CallMethod);
    AddClass(TTabControl, 'TWinControl');
    with AddClass(TTabSheet, 'TWinControl') do
      AddProperty('PageControl', 'TPageControl', GetProp, SetProp);
    with AddClass(TPageControl, 'TWinControl') do
    begin
      AddMethod('procedure SelectNextPage(GoForward: Boolean)', CallMethod);
      AddProperty('PageCount', 'Integer', GetProp, nil);
      AddIndexProperty('Pages', 'Integer', 'TTabSheet', CallMethod, True);
    end;
    AddClass(TStatusPanel, 'TPersistent');
    with AddClass(TStatusPanels, 'TPersistent') do
    begin
      AddMethod('function Add: TStatusPanel', CallMethod);
      AddIndexProperty('Items', 'Integer', 'TStatusPanel', CallMethod, True);
    end;
    AddClass(TStatusBar, 'TWinControl');
    with AddClass(TTreeNode, 'TPersistent') do
    begin
      AddMethod('procedure Delete', CallMethod);
      AddMethod('function EditText: Boolean', CallMethod);
      AddProperty('Count', 'Integer', GetProp, nil);
      AddProperty('Data', 'Pointer', GetProp, SetProp);
      AddProperty('ImageIndex', 'Integer', GetProp, SetProp);
      AddProperty('SelectedIndex', 'Integer', GetProp, SetProp);
      AddProperty('StateIndex', 'Integer', GetProp, SetProp);
      AddProperty('Text', 'String', GetProp, SetProp);
    end;
    with AddClass(TTreeNodes, 'TPersistent') do
    begin
      AddMethod('function Add(Node: TTreeNode; const S: string): TTreeNode', CallMethod);
      AddMethod('function AddChild(Node: TTreeNode; const S: string): TTreeNode', CallMethod);
      AddMethod('procedure BeginUpdate', CallMethod);
      AddMethod('procedure Clear', CallMethod);
      AddMethod('procedure Delete(Node: TTreeNode)', CallMethod);
      AddMethod('procedure EndUpdate', CallMethod);
      AddProperty('Count', 'Integer', GetProp, nil);
      AddDefaultProperty('Item', 'Integer', 'TTreeNode', CallMethod, True);
    end;
    with AddClass(TTreeView, 'TWinControl') do
    begin
      AddMethod('procedure FullCollapse', CallMethod);
      AddMethod('procedure FullExpand', CallMethod);
      AddProperty('Items', 'TTreeNodes', GetProp, nil);
      AddProperty('Selected', 'TTreeNode', GetProp, SetProp);
      AddProperty('TopItem', 'TTreeNode', GetProp, SetProp);
    end;
    AddClass(TTrackBar, 'TWinControl');
    AddClass(TProgressBar, 'TWinControl');
    AddClass(TListColumn, 'TPersistent');
    with AddClass(TListColumns, 'TPersistent') do
    begin
      AddMethod('function Add: TListColumn', CallMethod);
      AddDefaultProperty('Items', 'Integer', 'TListColumn', CallMethod, True);
    end;
    with AddClass(TListItem, 'TPersistent') do
    begin
      AddMethod('procedure Delete', CallMethod);
      AddMethod('function EditCaption: Boolean', CallMethod);
      AddProperty('Caption', 'String', GetProp, SetProp);
      AddProperty('Checked', 'Boolean', GetProp, SetProp);
      AddProperty('Data', 'Pointer', GetProp, SetProp);
      AddProperty('ImageIndex', 'Integer', GetProp, SetProp);
      AddProperty('Selected', 'Boolean', GetProp, SetProp);
      AddProperty('StateIndex', 'Integer', GetProp, SetProp);
      AddProperty('SubItems', 'TStrings', GetProp, SetProp);
    end;
    with AddClass(TListItems, 'TPersistent') do
    begin
      AddMethod('function Add: TListItem', CallMethod);
      AddMethod('procedure BeginUpdate', CallMethod);
      AddMethod('procedure Clear', CallMethod);
      AddMethod('procedure Delete(Index: Integer)', CallMethod);
      AddMethod('procedure EndUpdate', CallMethod);
      AddProperty('Count', 'Integer', GetProp, nil);
      AddDefaultProperty('Item', 'Integer', 'TListItem', CallMethod, True);
    end;
{$IFNDEF FPC}
    AddClass(TIconOptions, 'TPersistent');
{$ENDIF}
    AddClass(TListView, 'TWinControl');
    AddClass(TToolButton, 'TGraphicControl');
    AddClass(TToolBar, 'TWinControl');
{$IFNDEF CLX}
  {$IFNDEF FPC}
    AddClass(TMonthCalColors, 'TPersistent');
    AddClass(TDateTimePicker, 'TWinControl');
    AddClass(TMonthCalendar, 'TWinControl');
    AddClass(TCustomRichEdit, 'TWinControl');
    AddClass(TRichEdit, 'TCustomRichEdit');
  {$ENDIF}
{$ENDIF}
  end;
end;

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
  const MethodName: String; Caller: TfsMethodHelper): Variant;
begin
  Result := 0;

  if ClassType = TCheckListBox then
  begin
    if MethodName = 'CHECKED.GET' then
      Result := TCheckListBox(Instance).Checked[Caller.Params[0]]
    else if MethodName = 'CHECKED.SET' then
      TCheckListBox(Instance).Checked[Caller.Params[0]] := Caller.Params[1]
  end
  else if ClassType = TPageControl then
  begin
    if MethodName = 'SELECTNEXTPAGE' then
      TPageControl(Instance).SelectNextPage(Caller.Params[0])
    else if MethodName = 'PAGES.GET' then
      Result := frxInteger(TPageControl(Instance).Pages[Caller.Params[0]])
  end
  else if ClassType = TStatusPanels then
  begin
    if MethodName = 'ADD' then
      Result := frxInteger(TStatusPanels(Instance).Add)
    else if MethodName = 'ITEMS.GET' then
      Result := frxInteger(TStatusPanels(Instance).Items[Caller.Params[0]])
  end
  else if ClassType = TTreeNode then
  begin
    if MethodName = 'DELETE' then
      TTreeNode(Instance).Delete
    else if MethodName = 'EDITTEXT' then
      Result := TTreeNode(Instance).EditText
  end
  else if ClassType = TTreeNodes then
  begin
    if MethodName = 'ADD' then
      Result := frxInteger(TTreeNodes(Instance).Add(TTreeNode(frxInteger(Caller.Params[0])),
        Caller.Params[1]))
    else if MethodName = 'ADDCHILD' then
      Result := frxInteger(TTreeNodes(Instance).AddChild(TTreeNode(frxInteger(Caller.Params[0])),
        Caller.Params[1]))
    else if MethodName = 'BEGINUPDATE' then
      TTreeNodes(Instance).BeginUpdate
    else if MethodName = 'CLEAR' then
      TTreeNodes(Instance).Clear
    else if MethodName = 'DELETE' then
      TTreeNodes(Instance).Delete(TTreeNode(frxInteger(Caller.Params[0])))
    else if MethodName = 'ENDUPDATE' then
      TTreeNodes(Instance).EndUpdate
    else if MethodName = 'ITEM.GET' then
      Result := frxInteger(TTreeNodes(Instance).Item[Caller.Params[0]])
  end
  else if ClassType = TTreeView then
  begin
    if MethodName = 'FULLCOLLAPSE' then
      TTreeView(Instance).FullCollapse
    else if MethodName = 'FULLEXPAND' then
      TTreeView(Instance).FullExpand
  end
  else if ClassType = TListColumns then
  begin
    if MethodName = 'ADD' then
      Result := frxInteger(TListColumns(Instance).Add)
    else if MethodName = 'ITEMS.GET' then
      Result := frxInteger(TListColumns(Instance).Items[Caller.Params[0]])
  end
  else if ClassType = TListItem then
  begin
    if MethodName = 'DELETE' then
      TListItem(Instance).Delete
{$IFNDEF CLX}
  {$IFNDEF FPC}
    else if MethodName = 'EDITCAPTION' then
      Result := TListItem(Instance).EditCaption
  {$ENDIF}
{$ENDIF}
  end
  else if ClassType = TListItems then
  begin
    if MethodName = 'ADD' then
      Result := frxInteger(TListItems(Instance).Add)
{$IFNDEF FPC}
    else if MethodName = 'BEGINUPDATE' then
      TListItems(Instance).BeginUpdate
{$ENDIF}
    else if MethodName = 'CLEAR' then
      TListItems(Instance).Clear
    else if MethodName = 'DELETE' then
      TListItems(Instance).Delete(Caller.Params[0])
{$IFNDEF FPC}
    else if MethodName = 'ENDUPDATE' then
      TListItems(Instance).EndUpdate
{$ENDIF}
    else if MethodName = 'ITEM.GET' then
      Result := frxInteger(TListItems(Instance).Item[Caller.Params[0]])
  end
end;

function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
  const PropName: String): Variant;
begin
  Result := 0;

  if ClassType = TPageControl then
  begin
    if PropName = 'PAGECOUNT' then
      Result := TPageControl(Instance).PageCount
  end
  else if ClassType = TTabSheet then
  begin
    if PropName = 'PAGECONTROL' then
      Result := frxInteger(TTabSheet(Instance).PageControl)
  end
  else if ClassType = TTreeNode then
  begin
    if PropName = 'COUNT' then
      Result := TTreeNode(Instance).Count
    else if PropName = 'DATA' then
      Result := frxInteger(TTreeNode(Instance).Data)
    else if PropName = 'IMAGEINDEX' then
      Result := TTreeNode(Instance).ImageIndex
    else if PropName = 'SELECTEDINDEX' then
      Result := TTreeNode(Instance).SelectedIndex
{$IFNDEF CLX}
    else if PropName = 'STATEINDEX' then
      Result := TTreeNode(Instance).StateIndex
{$ENDIF}
    else if PropName = 'TEXT' then
      Result := TTreeNode(Instance).Text
  end
  else if ClassType = TTreeNodes then
  begin
    if PropName = 'COUNT' then
      Result := TTreeNodes(Instance).Count
  end
  else if ClassType = TTreeView then
  begin
    if PropName = 'ITEMS' then
      Result := frxInteger(TTreeView(Instance).Items)
    else if PropName = 'SELECTED' then
      Result := frxInteger(TTreeView(Instance).Selected)
    else if PropName = 'TOPITEM' then
      Result := frxInteger(TTreeView(Instance).TopItem)
  end
  else if ClassType = TListItem then
  begin
    if PropName = 'CAPTION' then
      Result := TListItem(Instance).Caption
    else if PropName = 'CHECKED' then
      Result := TListItem(Instance).Checked
    else if PropName = 'DATA' then
      Result := frxInteger(TListItem(Instance).Data)
    else if PropName = 'IMAGEINDEX' then
      Result := TListItem(Instance).ImageIndex
    else if PropName = 'SELECTED' then
      Result := TListItem(Instance).Selected
{$IFNDEF CLX}
  {$IFNDEF FPC}
    else if PropName = 'STATEINDEX' then
      Result := TListItem(Instance).StateIndex
  {$ENDIF}
{$ENDIF}
    else if PropName = 'SUBITEMS' then
      Result := frxInteger(TListItem(Instance).SubItems)
  end
  else if ClassType = TListItems then
  begin
    if PropName = 'COUNT' then
      Result := TListItems(Instance).Count
  end
end;

procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
  const PropName: String; Value: Variant);
begin
  if ClassType = TTabSheet then
  begin
    if PropName = 'PAGECONTROL' then
      TTabSheet(Instance).PageControl := TPageControl(frxInteger(Value))
  end
  else if ClassType = TTreeNode then
  begin
    if PropName = 'DATA' then
      TTreeNode(Instance).Data := Pointer(frxInteger(Value))
    else if PropName = 'IMAGEINDEX' then
      TTreeNode(Instance).ImageIndex := frxInteger(Value)
    else if PropName = 'SELECTEDINDEX' then
      TTreeNode(Instance).SelectedIndex := Value
{$IFNDEF CLX}
    else if PropName = 'STATEINDEX' then
      TTreeNode(Instance).StateIndex := Value
{$ENDIF}
    else if PropName = 'TEXT' then
      TTreeNode(Instance).Text := Value
  end
  else if ClassType = TTreeView then
  begin
    if PropName = 'SELECTED' then
      TTreeView(Instance).Selected := TTreeNode(frxInteger(Value))
    else if PropName = 'TOPITEM' then
      TTreeView(Instance).TopItem := TTreeNode(frxInteger(Value))
  end
  else if ClassType = TListItem then
  begin
    if PropName = 'CAPTION' then
      TListItem(Instance).Caption := Value
    else if PropName = 'CHECKED' then
      TListItem(Instance).Checked := Value
    else if PropName = 'DATA' then
      TListItem(Instance).Data := Pointer(frxInteger(Value))
    else if PropName = 'IMAGEINDEX' then
      TListItem(Instance).ImageIndex := Integer(Value)
    else if PropName = 'SELECTED' then
      TListItem(Instance).Selected := Value
{$IFNDEF CLX}
  {$IFNDEF FPC}
    else if PropName = 'STATEINDEX' then
      TListItem(Instance).StateIndex := Value
  {$ENDIF}
{$ENDIF}
    else if PropName = 'SUBITEMS' then
      TListItem(Instance).SubItems := TStrings(frxInteger(Value))
  end
end;


initialization
{$IFDEF Delphi16}
  StartClassGroup(TControl);
  ActivateClassGroup(TControl);
  GroupDescendentsWith(TfsExtCtrlsRTTI, TControl);
{$ENDIF}
  fsRTTIModules.Add(TFunctions);

finalization
  fsRTTIModules.Remove(TFunctions);

end.