fs_iextctrlsrtti.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

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

unit fs_iextctrlsrtti;

interface

{$i fs.inc}

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

type
  TfsExtCtrlsRTTI = class(TComponent); // fake component


implementation

type
  TFunctions = class(TObject)
  private
    function CallMethod(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): 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;
    destructor Destroy; override;
  end;

var
  Functions: TFunctions;


{ TFunctions }

constructor TFunctions.Create;
begin
  with fsGlobalUnit do
  begin
    AddedBy := Self;
    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, 'TGraphicControl');
    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;
    AddClass(TIconOptions, 'TPersistent');
    AddClass(TListView, 'TWinControl');
    AddClass(TToolButton, 'TGraphicControl');
    AddClass(TToolBar, 'TWinControl');
{$IFNDEF CLX}
    AddClass(TMonthCalColors, 'TPersistent');
    AddClass(TDateTimePicker, 'TWinControl');
    AddClass(TMonthCalendar, 'TWinControl');
    AddClass(TCustomRichEdit, 'TWinControl');
    AddClass(TRichEdit, 'TCustomRichEdit');
{$ENDIF}

    AddedBy := nil;
  end;
end;

destructor TFunctions.Destroy;
begin
  if fsGlobalUnit <> nil then
    fsGlobalUnit.RemoveItems(Self);
  inherited;
end;

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

  if ClassType = TCheckListBox then
  begin
    if MethodName = 'CHECKED.GET' then
      Result := TCheckListBox(Instance).Checked[Params[0]]
    else if MethodName = 'CHECKED.SET' then
      TCheckListBox(Instance).Checked[Params[0]] := Params[1]
  end
  else if ClassType = TPageControl then