Code-Formatting
This commit is contained in:
Michael Schimmel
+242
-234
@@ -3,135 +3,143 @@ unit DynamicFMXControl;
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
FMX.Controls, FMX.Graphics, FMX.Forms, FMX.StdCtrls, FMX.Types;
|
||||
System.SysUtils,
|
||||
System.Types,
|
||||
System.UITypes,
|
||||
System.Classes,
|
||||
FMX.Controls,
|
||||
FMX.Graphics,
|
||||
FMX.Forms,
|
||||
FMX.StdCtrls,
|
||||
FMX.Types;
|
||||
|
||||
type
|
||||
// Dezidierte Event-Typen für virtuelle Methoden von TControl
|
||||
TControlPaintEvent = reference to procedure;
|
||||
TControlMouseEvent = reference to procedure(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
TControlMouseMoveEvent = reference to procedure(Shift: TShiftState; X, Y: Single);
|
||||
TControlMouseWheelEvent = reference to procedure(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||
TControlKeyEvent = reference to procedure(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
TControlDragEvent = reference to procedure(const Data: TDragObject; const Point: TPointF);
|
||||
TControlDragOverEvent = reference to procedure(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||
TControlNotifyEvent = reference to procedure;
|
||||
TControlCanFocusEvent = reference to function: Boolean;
|
||||
TControlShowContextMenuEvent = reference to function(const ScreenPosition: TPointF): Boolean;
|
||||
TControlSetHintEvent = reference to procedure(const AHint: string);
|
||||
TControlGetHintStringEvent = reference to function: string;
|
||||
TControlHasHintEvent = reference to function: Boolean;
|
||||
TControlCanShowHintEvent = reference to function: Boolean;
|
||||
TControlGetDefaultSizeEvent = reference to function: TSizeF;
|
||||
TControlSetVisibleEvent = reference to procedure(const Value: Boolean);
|
||||
TControlSetEnabledEvent = reference to procedure(const Value: Boolean);
|
||||
TControlDoAbsoluteChangedEvent = reference to procedure;
|
||||
// Dezidierte Event-Typen für virtuelle Methoden von TControl
|
||||
TControlPaintEvent = reference to procedure;
|
||||
TControlMouseEvent = reference to procedure(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
TControlMouseMoveEvent = reference to procedure(Shift: TShiftState; X, Y: Single);
|
||||
TControlMouseWheelEvent = reference to procedure(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||
TControlKeyEvent = reference to procedure(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
TControlDragEvent = reference to procedure(const Data: TDragObject; const Point: TPointF);
|
||||
TControlDragOverEvent = reference to procedure(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||
TControlNotifyEvent = reference to procedure;
|
||||
TControlCanFocusEvent = reference to function: Boolean;
|
||||
TControlShowContextMenuEvent = reference to function(const ScreenPosition: TPointF): Boolean;
|
||||
TControlSetHintEvent = reference to procedure(const AHint: string);
|
||||
TControlGetHintStringEvent = reference to function: string;
|
||||
TControlHasHintEvent = reference to function: Boolean;
|
||||
TControlCanShowHintEvent = reference to function: Boolean;
|
||||
TControlGetDefaultSizeEvent = reference to function: TSizeF;
|
||||
TControlSetVisibleEvent = reference to procedure(const Value: Boolean);
|
||||
TControlSetEnabledEvent = reference to procedure(const Value: Boolean);
|
||||
TControlDoAbsoluteChangedEvent = reference to procedure;
|
||||
|
||||
TDynamicControl = class(TControl)
|
||||
private
|
||||
// Private Felder für die Event-Handler
|
||||
FPaintEvent: TControlPaintEvent;
|
||||
FMouseDownEvent: TControlMouseEvent;
|
||||
FMouseUpEvent: TControlMouseEvent;
|
||||
FMouseMoveEvent: TControlMouseMoveEvent;
|
||||
FMouseWheelEvent: TControlMouseWheelEvent;
|
||||
FKeyDownEvent: TControlKeyEvent;
|
||||
FKeyUpEvent: TControlKeyEvent;
|
||||
FClickEvent: TControlNotifyEvent;
|
||||
FDblClickEvent: TControlNotifyEvent;
|
||||
FDragEnterEvent: TControlDragEvent;
|
||||
FDragOverEvent: TControlDragOverEvent;
|
||||
FDragDropEvent: TControlDragEvent;
|
||||
FDragLeaveEvent: TControlNotifyEvent;
|
||||
FDragEndEvent: TControlNotifyEvent;
|
||||
FEnterEvent: TControlNotifyEvent;
|
||||
FExitEvent: TControlNotifyEvent;
|
||||
FMouseEnterEvent: TControlNotifyEvent;
|
||||
FMouseLeaveEvent: TControlNotifyEvent;
|
||||
FResizeEvent: TControlNotifyEvent;
|
||||
FResizedEvent: TControlNotifyEvent;
|
||||
FCanFocusEvent: TControlCanFocusEvent;
|
||||
FShowContextMenuEvent: TControlShowContextMenuEvent;
|
||||
FSetHintEvent: TControlSetHintEvent;
|
||||
FGetHintStringEvent: TControlGetHintStringEvent;
|
||||
FHasHintEvent: TControlHasHintEvent;
|
||||
FCanShowHintEvent: TControlCanShowHintEvent;
|
||||
FGetDefaultSizeEvent: TControlGetDefaultSizeEvent;
|
||||
FRecalculateAbsoluteMatricesEvent: TControlNotifyEvent;
|
||||
FSetVisibleEvent: TControlSetVisibleEvent;
|
||||
FSetEnabledEvent: TControlSetEnabledEvent;
|
||||
FDoAbsoluteChangedEvent: TControlDoAbsoluteChangedEvent;
|
||||
TDynamicControl = class(TControl)
|
||||
private
|
||||
// Private Felder für die Event-Handler
|
||||
FPaintEvent: TControlPaintEvent;
|
||||
FMouseDownEvent: TControlMouseEvent;
|
||||
FMouseUpEvent: TControlMouseEvent;
|
||||
FMouseMoveEvent: TControlMouseMoveEvent;
|
||||
FMouseWheelEvent: TControlMouseWheelEvent;
|
||||
FKeyDownEvent: TControlKeyEvent;
|
||||
FKeyUpEvent: TControlKeyEvent;
|
||||
FClickEvent: TControlNotifyEvent;
|
||||
FDblClickEvent: TControlNotifyEvent;
|
||||
FDragEnterEvent: TControlDragEvent;
|
||||
FDragOverEvent: TControlDragOverEvent;
|
||||
FDragDropEvent: TControlDragEvent;
|
||||
FDragLeaveEvent: TControlNotifyEvent;
|
||||
FDragEndEvent: TControlNotifyEvent;
|
||||
FEnterEvent: TControlNotifyEvent;
|
||||
FExitEvent: TControlNotifyEvent;
|
||||
FMouseEnterEvent: TControlNotifyEvent;
|
||||
FMouseLeaveEvent: TControlNotifyEvent;
|
||||
FResizeEvent: TControlNotifyEvent;
|
||||
FResizedEvent: TControlNotifyEvent;
|
||||
FCanFocusEvent: TControlCanFocusEvent;
|
||||
FShowContextMenuEvent: TControlShowContextMenuEvent;
|
||||
FSetHintEvent: TControlSetHintEvent;
|
||||
FGetHintStringEvent: TControlGetHintStringEvent;
|
||||
FHasHintEvent: TControlHasHintEvent;
|
||||
FCanShowHintEvent: TControlCanShowHintEvent;
|
||||
FGetDefaultSizeEvent: TControlGetDefaultSizeEvent;
|
||||
FRecalculateAbsoluteMatricesEvent: TControlNotifyEvent;
|
||||
FSetVisibleEvent: TControlSetVisibleEvent;
|
||||
FSetEnabledEvent: TControlSetEnabledEvent;
|
||||
FDoAbsoluteChangedEvent: TControlDoAbsoluteChangedEvent;
|
||||
|
||||
protected
|
||||
// Überschriebene virtuelle Methoden, die die Events auslösen
|
||||
procedure Paint; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
|
||||
procedure Click; override;
|
||||
procedure DblClick; override;
|
||||
procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
||||
procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
||||
procedure DragEnter(const Data: TDragObject; const Point: TPointF); override;
|
||||
procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override;
|
||||
procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
|
||||
procedure DragLeave; override;
|
||||
procedure DragEnd; override;
|
||||
procedure DoEnter; override;
|
||||
procedure DoExit; override;
|
||||
procedure DoMouseEnter; override;
|
||||
procedure DoMouseLeave; override;
|
||||
procedure Resize; override;
|
||||
procedure DoResized; override;
|
||||
function GetCanFocus: Boolean; override;
|
||||
function ShowContextMenu(const ScreenPosition: TPointF): Boolean; override;
|
||||
procedure SetHint(const AHint: string); override;
|
||||
function GetHintString: string; override;
|
||||
function HasHint: Boolean; override;
|
||||
function CanShowHint: Boolean; override;
|
||||
function GetDefaultSize: TSizeF; override;
|
||||
procedure RecalculateAbsoluteMatrices; override;
|
||||
procedure SetVisible(const Value: Boolean); override;
|
||||
procedure SetEnabled(const Value: Boolean); override;
|
||||
procedure DoAbsoluteChanged; override;
|
||||
protected
|
||||
// Überschriebene virtuelle Methoden, die die Events auslösen
|
||||
procedure Paint; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
|
||||
procedure Click; override;
|
||||
procedure DblClick; override;
|
||||
procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
||||
procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
||||
procedure DragEnter(const Data: TDragObject; const Point: TPointF); override;
|
||||
procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override;
|
||||
procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
|
||||
procedure DragLeave; override;
|
||||
procedure DragEnd; override;
|
||||
procedure DoEnter; override;
|
||||
procedure DoExit; override;
|
||||
procedure DoMouseEnter; override;
|
||||
procedure DoMouseLeave; override;
|
||||
procedure Resize; override;
|
||||
procedure DoResized; override;
|
||||
function GetCanFocus: Boolean; override;
|
||||
function ShowContextMenu(const ScreenPosition: TPointF): Boolean; override;
|
||||
procedure SetHint(const AHint: string); override;
|
||||
function GetHintString: string; override;
|
||||
function HasHint: Boolean; override;
|
||||
function CanShowHint: Boolean; override;
|
||||
function GetDefaultSize: TSizeF; override;
|
||||
procedure RecalculateAbsoluteMatrices; override;
|
||||
procedure SetVisible(const Value: Boolean); override;
|
||||
procedure SetEnabled(const Value: Boolean); override;
|
||||
procedure DoAbsoluteChanged; override;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
|
||||
// Public Properties, die die Events exponieren
|
||||
property OnPaint: TControlPaintEvent read FPaintEvent write FPaintEvent;
|
||||
property OnMouseDown: TControlMouseEvent read FMouseDownEvent write FMouseDownEvent;
|
||||
property OnMouseUp: TControlMouseEvent read FMouseUpEvent write FMouseUpEvent;
|
||||
property OnMouseMove: TControlMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent;
|
||||
property OnMouseWheel: TControlMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent;
|
||||
property OnClick: TControlNotifyEvent read FClickEvent write FClickEvent;
|
||||
property OnDblClick: TControlNotifyEvent read FDblClickEvent write FDblClickEvent;
|
||||
property OnKeyDown: TControlKeyEvent read FKeyDownEvent write FKeyDownEvent;
|
||||
property OnKeyUp: TControlKeyEvent read FKeyUpEvent write FKeyUpEvent;
|
||||
property OnDragEnter: TControlDragEvent read FDragEnterEvent write FDragEnterEvent;
|
||||
property OnDragOver: TControlDragOverEvent read FDragOverEvent write FDragOverEvent;
|
||||
property OnDragDrop: TControlDragEvent read FDragDropEvent write FDragDropEvent;
|
||||
property OnDragLeave: TControlNotifyEvent read FDragLeaveEvent write FDragLeaveEvent;
|
||||
property OnDragEnd: TControlNotifyEvent read FDragEndEvent write FDragEndEvent;
|
||||
property OnEnter: TControlNotifyEvent read FEnterEvent write FEnterEvent;
|
||||
property OnExit: TControlNotifyEvent read FExitEvent write FExitEvent;
|
||||
property OnMouseEnter: TControlNotifyEvent read FMouseEnterEvent write FMouseEnterEvent;
|
||||
property OnMouseLeave: TControlNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent;
|
||||
property OnResize: TControlNotifyEvent read FResizeEvent write FResizeEvent;
|
||||
property OnResized: TControlNotifyEvent read FResizedEvent write FResizedEvent;
|
||||
property OnCanFocus: TControlCanFocusEvent read FCanFocusEvent write FCanFocusEvent;
|
||||
property OnShowContextMenu: TControlShowContextMenuEvent read FShowContextMenuEvent write FShowContextMenuEvent;
|
||||
property OnSetHint: TControlSetHintEvent read FSetHintEvent write FSetHintEvent;
|
||||
property OnGetHintString: TControlGetHintStringEvent read FGetHintStringEvent write FGetHintStringEvent;
|
||||
property OnHasHint: TControlHasHintEvent read FHasHintEvent write FHasHintEvent;
|
||||
property OnCanShowHint: TControlCanShowHintEvent read FCanShowHintEvent write FCanShowHintEvent;
|
||||
property OnGetDefaultSize: TControlGetDefaultSizeEvent read FGetDefaultSizeEvent write FGetDefaultSizeEvent;
|
||||
property OnRecalculateAbsoluteMatrices: TControlNotifyEvent read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent;
|
||||
property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent;
|
||||
property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent;
|
||||
property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent;
|
||||
end;
|
||||
// Public Properties, die die Events exponieren
|
||||
property OnPaint: TControlPaintEvent read FPaintEvent write FPaintEvent;
|
||||
property OnMouseDown: TControlMouseEvent read FMouseDownEvent write FMouseDownEvent;
|
||||
property OnMouseUp: TControlMouseEvent read FMouseUpEvent write FMouseUpEvent;
|
||||
property OnMouseMove: TControlMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent;
|
||||
property OnMouseWheel: TControlMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent;
|
||||
property OnClick: TControlNotifyEvent read FClickEvent write FClickEvent;
|
||||
property OnDblClick: TControlNotifyEvent read FDblClickEvent write FDblClickEvent;
|
||||
property OnKeyDown: TControlKeyEvent read FKeyDownEvent write FKeyDownEvent;
|
||||
property OnKeyUp: TControlKeyEvent read FKeyUpEvent write FKeyUpEvent;
|
||||
property OnDragEnter: TControlDragEvent read FDragEnterEvent write FDragEnterEvent;
|
||||
property OnDragOver: TControlDragOverEvent read FDragOverEvent write FDragOverEvent;
|
||||
property OnDragDrop: TControlDragEvent read FDragDropEvent write FDragDropEvent;
|
||||
property OnDragLeave: TControlNotifyEvent read FDragLeaveEvent write FDragLeaveEvent;
|
||||
property OnDragEnd: TControlNotifyEvent read FDragEndEvent write FDragEndEvent;
|
||||
property OnEnter: TControlNotifyEvent read FEnterEvent write FEnterEvent;
|
||||
property OnExit: TControlNotifyEvent read FExitEvent write FExitEvent;
|
||||
property OnMouseEnter: TControlNotifyEvent read FMouseEnterEvent write FMouseEnterEvent;
|
||||
property OnMouseLeave: TControlNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent;
|
||||
property OnResize: TControlNotifyEvent read FResizeEvent write FResizeEvent;
|
||||
property OnResized: TControlNotifyEvent read FResizedEvent write FResizedEvent;
|
||||
property OnCanFocus: TControlCanFocusEvent read FCanFocusEvent write FCanFocusEvent;
|
||||
property OnShowContextMenu: TControlShowContextMenuEvent read FShowContextMenuEvent write FShowContextMenuEvent;
|
||||
property OnSetHint: TControlSetHintEvent read FSetHintEvent write FSetHintEvent;
|
||||
property OnGetHintString: TControlGetHintStringEvent read FGetHintStringEvent write FGetHintStringEvent;
|
||||
property OnHasHint: TControlHasHintEvent read FHasHintEvent write FHasHintEvent;
|
||||
property OnCanShowHint: TControlCanShowHintEvent read FCanShowHintEvent write FCanShowHintEvent;
|
||||
property OnGetDefaultSize: TControlGetDefaultSizeEvent read FGetDefaultSizeEvent write FGetDefaultSizeEvent;
|
||||
property OnRecalculateAbsoluteMatrices: TControlNotifyEvent
|
||||
read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent;
|
||||
property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent;
|
||||
property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent;
|
||||
property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
@@ -139,241 +147,241 @@ implementation
|
||||
|
||||
constructor TDynamicControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Width := 150;
|
||||
Height := 100;
|
||||
HitTest := True;
|
||||
inherited Create(AOwner);
|
||||
Width := 150;
|
||||
Height := 100;
|
||||
HitTest := True;
|
||||
end;
|
||||
|
||||
function TDynamicControl.CanShowHint: Boolean;
|
||||
begin
|
||||
if Assigned(FCanShowHintEvent) then
|
||||
Result := FCanShowHintEvent
|
||||
else
|
||||
Result := inherited CanShowHint;
|
||||
if Assigned(FCanShowHintEvent) then
|
||||
Result := FCanShowHintEvent
|
||||
else
|
||||
Result := inherited CanShowHint;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Click;
|
||||
begin
|
||||
inherited Click;
|
||||
if Assigned(FClickEvent) then
|
||||
FClickEvent;
|
||||
inherited Click;
|
||||
if Assigned(FClickEvent) then
|
||||
FClickEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DblClick;
|
||||
begin
|
||||
inherited DblClick;
|
||||
if Assigned(FDblClickEvent) then
|
||||
FDblClickEvent;
|
||||
inherited DblClick;
|
||||
if Assigned(FDblClickEvent) then
|
||||
FDblClickEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoAbsoluteChanged;
|
||||
begin
|
||||
inherited DoAbsoluteChanged;
|
||||
if Assigned(FDoAbsoluteChangedEvent) then
|
||||
FDoAbsoluteChangedEvent;
|
||||
inherited DoAbsoluteChanged;
|
||||
if Assigned(FDoAbsoluteChangedEvent) then
|
||||
FDoAbsoluteChangedEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragDrop(const Data: TDragObject; const Point: TPointF);
|
||||
begin
|
||||
inherited DragDrop(Data, Point);
|
||||
if Assigned(FDragDropEvent) then
|
||||
FDragDropEvent(Data, Point);
|
||||
inherited DragDrop(Data, Point);
|
||||
if Assigned(FDragDropEvent) then
|
||||
FDragDropEvent(Data, Point);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragEnd;
|
||||
begin
|
||||
inherited DragEnd;
|
||||
if Assigned(FDragEndEvent) then
|
||||
FDragEndEvent;
|
||||
inherited DragEnd;
|
||||
if Assigned(FDragEndEvent) then
|
||||
FDragEndEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragEnter(const Data: TDragObject; const Point: TPointF);
|
||||
begin
|
||||
inherited DragEnter(Data, Point);
|
||||
if Assigned(FDragEnterEvent) then
|
||||
FDragEnterEvent(Data, Point);
|
||||
inherited DragEnter(Data, Point);
|
||||
if Assigned(FDragEnterEvent) then
|
||||
FDragEnterEvent(Data, Point);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragLeave;
|
||||
begin
|
||||
inherited DragLeave;
|
||||
if Assigned(FDragLeaveEvent) then
|
||||
FDragLeaveEvent;
|
||||
inherited DragLeave;
|
||||
if Assigned(FDragLeaveEvent) then
|
||||
FDragLeaveEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||
begin
|
||||
inherited DragOver(Data, Point, Operation);
|
||||
if Assigned(FDragOverEvent) then
|
||||
FDragOverEvent(Data, Point, Operation);
|
||||
inherited DragOver(Data, Point, Operation);
|
||||
if Assigned(FDragOverEvent) then
|
||||
FDragOverEvent(Data, Point, Operation);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoEnter;
|
||||
begin
|
||||
inherited DoEnter;
|
||||
if Assigned(FEnterEvent) then
|
||||
FEnterEvent;
|
||||
inherited DoEnter;
|
||||
if Assigned(FEnterEvent) then
|
||||
FEnterEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoExit;
|
||||
begin
|
||||
inherited DoExit;
|
||||
if Assigned(FExitEvent) then
|
||||
FExitEvent;
|
||||
inherited DoExit;
|
||||
if Assigned(FExitEvent) then
|
||||
FExitEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoMouseEnter;
|
||||
begin
|
||||
inherited DoMouseEnter;
|
||||
if Assigned(FMouseEnterEvent) then
|
||||
FMouseEnterEvent;
|
||||
inherited DoMouseEnter;
|
||||
if Assigned(FMouseEnterEvent) then
|
||||
FMouseEnterEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoMouseLeave;
|
||||
begin
|
||||
inherited DoMouseLeave;
|
||||
if Assigned(FMouseLeaveEvent) then
|
||||
FMouseLeaveEvent;
|
||||
inherited DoMouseLeave;
|
||||
if Assigned(FMouseLeaveEvent) then
|
||||
FMouseLeaveEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoResized;
|
||||
begin
|
||||
inherited DoResized;
|
||||
if Assigned(FResizedEvent) then
|
||||
FResizedEvent;
|
||||
inherited DoResized;
|
||||
if Assigned(FResizedEvent) then
|
||||
FResizedEvent;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetCanFocus: Boolean;
|
||||
begin
|
||||
if Assigned(FCanFocusEvent) then
|
||||
Result := FCanFocusEvent
|
||||
else
|
||||
Result := inherited GetCanFocus;
|
||||
if Assigned(FCanFocusEvent) then
|
||||
Result := FCanFocusEvent
|
||||
else
|
||||
Result := inherited GetCanFocus;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetDefaultSize: TSizeF;
|
||||
begin
|
||||
if Assigned(FGetDefaultSizeEvent) then
|
||||
Result := FGetDefaultSizeEvent
|
||||
else
|
||||
Result := inherited GetDefaultSize;
|
||||
if Assigned(FGetDefaultSizeEvent) then
|
||||
Result := FGetDefaultSizeEvent
|
||||
else
|
||||
Result := inherited GetDefaultSize;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetHintString: string;
|
||||
begin
|
||||
if Assigned(FGetHintStringEvent) then
|
||||
Result := FGetHintStringEvent
|
||||
else
|
||||
Result := inherited GetHintString;
|
||||
if Assigned(FGetHintStringEvent) then
|
||||
Result := FGetHintStringEvent
|
||||
else
|
||||
Result := inherited GetHintString;
|
||||
end;
|
||||
|
||||
function TDynamicControl.HasHint: Boolean;
|
||||
begin
|
||||
if Assigned(FHasHintEvent) then
|
||||
Result := FHasHintEvent
|
||||
else
|
||||
Result := inherited HasHint;
|
||||
if Assigned(FHasHintEvent) then
|
||||
Result := FHasHintEvent
|
||||
else
|
||||
Result := inherited HasHint;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyDownEvent) then
|
||||
FKeyDownEvent(Key, KeyChar, Shift);
|
||||
inherited KeyDown(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyDownEvent) then
|
||||
FKeyDownEvent(Key, KeyChar, Shift);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyUp(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyUpEvent) then
|
||||
FKeyUpEvent(Key, KeyChar, Shift);
|
||||
inherited KeyUp(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyUpEvent) then
|
||||
FKeyUpEvent(Key, KeyChar, Shift);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if Assigned(FMouseDownEvent) then
|
||||
FMouseDownEvent(Button, Shift, X, Y);
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if Assigned(FMouseDownEvent) then
|
||||
FMouseDownEvent(Button, Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
if Assigned(FMouseMoveEvent) then
|
||||
FMouseMoveEvent(Shift, X, Y);
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
if Assigned(FMouseMoveEvent) then
|
||||
FMouseMoveEvent(Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseUp(Button, Shift, X, Y);
|
||||
if Assigned(FMouseUpEvent) then
|
||||
FMouseUpEvent(Button, Shift, X, Y);
|
||||
inherited MouseUp(Button, Shift, X, Y);
|
||||
if Assigned(FMouseUpEvent) then
|
||||
FMouseUpEvent(Button, Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||
begin
|
||||
inherited MouseWheel(Shift, WheelDelta, Handled);
|
||||
if Assigned(FMouseWheelEvent) then
|
||||
FMouseWheelEvent(Shift, WheelDelta, Handled);
|
||||
inherited MouseWheel(Shift, WheelDelta, Handled);
|
||||
if Assigned(FMouseWheelEvent) then
|
||||
FMouseWheelEvent(Shift, WheelDelta, Handled);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Paint;
|
||||
begin
|
||||
inherited Paint;
|
||||
if Assigned(FPaintEvent) then
|
||||
FPaintEvent
|
||||
else
|
||||
begin
|
||||
Canvas.Fill.Color := TAlphaColors.LightSteelBlue;
|
||||
Canvas.FillRect(LocalRect, 0, 0, [], 1);
|
||||
Canvas.Stroke.Color := TAlphaColors.Gray;
|
||||
Canvas.Stroke.Thickness := 1;
|
||||
Canvas.DrawRect(LocalRect, 0, 0, [], 1);
|
||||
end;
|
||||
inherited Paint;
|
||||
if Assigned(FPaintEvent) then
|
||||
FPaintEvent
|
||||
else
|
||||
begin
|
||||
Canvas.Fill.Color := TAlphaColors.LightSteelBlue;
|
||||
Canvas.FillRect(LocalRect, 0, 0, [], 1);
|
||||
Canvas.Stroke.Color := TAlphaColors.Gray;
|
||||
Canvas.Stroke.Thickness := 1;
|
||||
Canvas.DrawRect(LocalRect, 0, 0, [], 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.RecalculateAbsoluteMatrices;
|
||||
begin
|
||||
inherited RecalculateAbsoluteMatrices;
|
||||
if Assigned(FRecalculateAbsoluteMatricesEvent) then
|
||||
FRecalculateAbsoluteMatricesEvent;
|
||||
inherited RecalculateAbsoluteMatrices;
|
||||
if Assigned(FRecalculateAbsoluteMatricesEvent) then
|
||||
FRecalculateAbsoluteMatricesEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Resize;
|
||||
begin
|
||||
inherited Resize;
|
||||
if Assigned(FResizeEvent) then
|
||||
FResizeEvent;
|
||||
inherited Resize;
|
||||
if Assigned(FResizeEvent) then
|
||||
FResizeEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetEnabled(const Value: Boolean);
|
||||
begin
|
||||
inherited SetEnabled(Value);
|
||||
if Assigned(FSetEnabledEvent) then
|
||||
FSetEnabledEvent(Value);
|
||||
inherited SetEnabled(Value);
|
||||
if Assigned(FSetEnabledEvent) then
|
||||
FSetEnabledEvent(Value);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetHint(const AHint: string);
|
||||
begin
|
||||
inherited SetHint(AHint);
|
||||
if Assigned(FSetHintEvent) then
|
||||
FSetHintEvent(AHint);
|
||||
inherited SetHint(AHint);
|
||||
if Assigned(FSetHintEvent) then
|
||||
FSetHintEvent(AHint);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetVisible(const Value: Boolean);
|
||||
begin
|
||||
inherited SetVisible(Value);
|
||||
if Assigned(FSetVisibleEvent) then
|
||||
FSetVisibleEvent(Value);
|
||||
inherited SetVisible(Value);
|
||||
if Assigned(FSetVisibleEvent) then
|
||||
FSetVisibleEvent(Value);
|
||||
end;
|
||||
|
||||
function TDynamicControl.ShowContextMenu(const ScreenPosition: TPointF): Boolean;
|
||||
begin
|
||||
if Assigned(FShowContextMenuEvent) then
|
||||
Result := FShowContextMenuEvent(ScreenPosition)
|
||||
else
|
||||
Result := inherited ShowContextMenu(ScreenPosition);
|
||||
if Assigned(FShowContextMenuEvent) then
|
||||
Result := FShowContextMenuEvent(ScreenPosition)
|
||||
else
|
||||
Result := inherited ShowContextMenu(ScreenPosition);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user