269 lines
10 KiB
ObjectPascal
269 lines
10 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastScript v1.9 }
|
|
{ ExtCtrls }
|
|
{ }
|
|
{ (c) 2003-2007 by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.fs_iextctrlsrtti;
|
|
|
|
interface
|
|
|
|
{$i fs.inc}
|
|
|
|
uses System.Types, System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_ievents, FMX.fs_iformsrtti
|
|
, FMX.ExtCtrls, FMX.ListBox, FMX.Objects, System.UITypes, FMX.Types, FMX.Controls, FMX.Layouts,
|
|
FMX.TabControl, FMX.TreeView
|
|
{$IFDEF DELPHI18}
|
|
, FMX.StdCtrls
|
|
{$ENDIF};
|
|
|
|
type
|
|
{$i frxPlatformsAttribute.inc}
|
|
TfsExtCtrlsRTTI = class(TComponent); // fake component
|
|
|
|
|
|
implementation
|
|
|
|
type
|
|
TfsTreeViewDragChange = class(TfsCustomEvent)
|
|
public
|
|
procedure DoEvent(SourceItem, DestItem: TTreeViewItem; var Allow: Boolean);
|
|
function GetMethod: Pointer; override;
|
|
end;
|
|
|
|
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');
|
|
|
|
|
|
with AddClass(TPaintBox, 'TControl') do
|
|
AddEvent('OnPaint', TfsNotifyEvent);
|
|
AddClass(TImage, 'TControl');
|
|
with AddClass(TTimer, 'TComponent') do
|
|
AddEvent('OnTimer', TfsNotifyEvent);
|
|
|
|
AddClass(TTabItem, 'TTextControl');
|
|
with AddClass(TTabControl, 'TStyledControl') do
|
|
begin
|
|
AddIndexProperty( 'Tabs', 'Integer', 'TTabItem', CallMethod);
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
|
AddProperty('TabCount', 'Integer', GetProp, nil);
|
|
AddProperty('ActiveTab', 'TTabItem', GetProp, SetProp);
|
|
end;
|
|
|
|
with AddClass(TTreeViewItem, 'TTextControl') do
|
|
begin
|
|
AddMethod('function ItemByPoint(const X, Y: Single): TTreeViewItem', CallMethod);
|
|
AddMethod('function ItemByIndex(const Idx: Integer): TTreeViewItem', CallMethod);
|
|
AddMethod('function TreeView: TCustomTreeView', CallMethod);
|
|
AddMethod('function Level: Integer', CallMethod);
|
|
AddMethod('function ParentItem: TTreeViewItem', CallMethod);
|
|
AddIndexProperty( 'Items', 'Integer', 'TTreeViewItem', CallMethod);
|
|
AddProperty('GlobalIndex', 'Integer', GetProp, SetProp);
|
|
AddProperty('Count', 'Integer', GetProp, nil);
|
|
end;
|
|
with AddClass(TTreeView, 'TScrollBox') do
|
|
begin
|
|
AddMethod('procedure Clear', CallMethod);
|
|
AddMethod('procedure CollapseAll', CallMethod);
|
|
AddMethod('procedure ExpandAll', CallMethod);
|
|
AddMethod('function ItemByText(const AText: string): TTreeViewItem', CallMethod);
|
|
AddMethod('function ItemByPoint(const X, Y: Single): TTreeViewItem', CallMethod);
|
|
AddMethod('function ItemByIndex(const Idx: Integer): TTreeViewItem', CallMethod);
|
|
AddMethod('function ItemByGlobalIndex(const Idx: Integer): TTreeViewItem', CallMethod);
|
|
AddIndexProperty('Items', 'Integer', 'TTreeViewItem', CallMethod);
|
|
AddProperty('Selected', 'TTreeViewItem', GetProp, SetProp);
|
|
AddProperty('Count', 'Integer', GetProp, nil);
|
|
AddProperty('GlobalCount', 'Integer', GetProp, nil);
|
|
AddProperty('CountExpanded', 'Integer', GetProp, nil);
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
|
AddEvent('OnChangeCheck', TfsNotifyEvent);
|
|
AddEvent('OnDragChange', TfsTreeViewDragChange);
|
|
end;
|
|
|
|
{ TODO ADD necessary methods for these calasses }
|
|
//AddClass(TCalendar, 'TStyledControl');
|
|
//AddClass(TCalendarBox, 'TTextControl');
|
|
// AddClass(TCalendarEdit, 'TCustomEdit');
|
|
AddClass(TImageViewer, 'TScrollBox');
|
|
AddClass(TPlotGrid, 'TControl');
|
|
AddClass(TDropTarget, 'TTextControl');
|
|
AddClass(TCornerButton, 'TCustomButton');
|
|
end;
|
|
end;
|
|
|
|
function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
begin
|
|
Result := 0;
|
|
if ClassType = TTabControl then
|
|
begin
|
|
if MethodName = 'TABS.GET' then
|
|
Result := frxInteger(TTabControl(Instance).Tabs[Caller.Params[0]])
|
|
end
|
|
else if ClassType = TTreeViewItem then
|
|
begin
|
|
if MethodName = 'ITEMS.GET' then
|
|
Result := frxInteger(TTreeViewItem(Instance).Items[Caller.Params[0]])
|
|
else if MethodName = 'ITEMBYPOINT' then
|
|
Result := frxInteger(TTreeViewItem(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1])))
|
|
else if MethodName = 'ITEMBYINDEX' then
|
|
Result := frxInteger(TTreeViewItem(Instance).ItemByIndex(Caller.Params[0]))
|
|
else if MethodName = 'TREEVIEW' then
|
|
Result := frxInteger(TTreeViewItem(Instance).TreeView)
|
|
else if MethodName = 'LEVEL' then
|
|
Result := Integer(TTreeViewItem(Instance).Level)
|
|
else if MethodName = 'PARENTITEM' then
|
|
Result := frxInteger(TTreeViewItem(Instance).ParentItem)
|
|
end
|
|
else if ClassType = TTreeView then
|
|
begin
|
|
if MethodName = 'ITEMS.GET' then
|
|
Result := frxInteger(TTreeView(Instance).Items[Caller.Params[0]])
|
|
else if MethodName = 'ITEMBYPOINT' then
|
|
Result := frxInteger(TTreeView(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1])))
|
|
else if MethodName = 'ITEMBYINDEX' then
|
|
Result := frxInteger(TTreeView(Instance).ItemByIndex(Caller.Params[0]))
|
|
else if MethodName = 'ITEMBYTEXT' then
|
|
Result := frxInteger(TTreeView(Instance).ItemByText(String(Caller.Params[0])))
|
|
else if MethodName = 'ITEMBYGLOBALINDEX' then
|
|
Result := frxInteger(TTreeView(Instance).ItemByGlobalIndex(Caller.Params[0]))
|
|
else if MethodName = 'CLEAR' then
|
|
TTreeView(Instance).Clear
|
|
else if MethodName = 'COLLAPSEALL' then
|
|
TTreeView(Instance).CollapseAll
|
|
else if MethodName = 'EXPANDALL' then
|
|
TTreeView(Instance).ExpandAll
|
|
end
|
|
end;
|
|
|
|
function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
|
|
const PropName: String): Variant;
|
|
begin
|
|
Result := 0;
|
|
if ClassType = TTabControl then
|
|
begin
|
|
if PropName = 'TABCOUNT' then
|
|
Result := TTabControl(Instance).TabCount
|
|
else if PropName = 'ACTIVETAB' then
|
|
Result := frxInteger(TTabControl(Instance).ActiveTab)
|
|
end
|
|
else if ClassType = TTreeViewItem then
|
|
begin
|
|
if PropName = 'GLOBALINDEX' then
|
|
Result := TTreeViewItem(Instance).GlobalIndex
|
|
else if PropName = 'COUNT' then
|
|
Result := TTreeViewItem(Instance).Count
|
|
end
|
|
else if ClassType = TTreeView then
|
|
begin
|
|
if PropName = 'SELECTED' then
|
|
Result := frxInteger(TTreeView(Instance).Selected)
|
|
else if PropName = 'COUNT' then
|
|
Result := TTreeView(Instance).Count
|
|
else if PropName = 'GLOBALCOUNT' then
|
|
Result := TTreeView(Instance).GlobalCount
|
|
else if PropName = 'COUNTEXPANDED' then
|
|
Result := TTreeView(Instance).CountExpanded
|
|
end
|
|
end;
|
|
|
|
procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
|
|
const PropName: String; Value: Variant);
|
|
begin
|
|
if ClassType = TTabControl then
|
|
begin
|
|
if PropName = 'ACTIVETAB' then
|
|
TTabControl(Instance).ActiveTab := TTabItem(frxInteger(Value))
|
|
end
|
|
else if ClassType = TTreeViewItem then
|
|
begin
|
|
// if PropName = 'GLOBALINDEX' then
|
|
// TTreeViewItem(Instance).GlobalIndex := Value
|
|
end
|
|
else if ClassType = TTreeView then
|
|
begin
|
|
if PropName = 'SELECTED' then
|
|
TTreeView(Instance).Selected := TTreeViewItem(frxInteger(Value))
|
|
end
|
|
end;
|
|
|
|
{ TfsTreeViewDragChange }
|
|
|
|
procedure TfsTreeViewDragChange.DoEvent(SourceItem, DestItem: TTreeViewItem;
|
|
var Allow: Boolean);
|
|
begin
|
|
CallHandler([SourceItem, DestItem, Allow]);
|
|
Allow := Handler.Params[2].Value;
|
|
end;
|
|
|
|
function TfsTreeViewDragChange.GetMethod: Pointer;
|
|
begin
|
|
Result := @TfsTreeViewDragChange.DoEvent;
|
|
end;
|
|
|
|
initialization
|
|
StartClassGroup(TFmxObject);
|
|
ActivateClassGroup(TFmxObject);
|
|
GroupDescendentsWith(TfsExtCtrlsRTTI, TFmxObject);
|
|
fsRTTIModules.Add(TFunctions);
|
|
|
|
finalization
|
|
fsRTTIModules.Remove(TFunctions);
|
|
|
|
end.
|