|
- unit uutlEventManager;
-
- { Package: Utils
- Prefix: utl - UTiLs
- Beschreibung: diese Unit verwaltet Events und verteilt diese an registrierte Programm-Teile }
-
- {$mode objfpc}{$H+}
-
- interface
-
- uses
- Classes, SysUtils, Controls,
- uutlEvent, uutlCommon;
-
- type
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventType = byte;
- TutlEventTypes = set of TutlEventType;
- TutlMouseButtons = set of TMouseButton;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlWinControlEventArgs = class(TutlEventArgs)
- private
- fControl: TControl;
- fEventType: TutlEventType;
- fTimestamp: Single;
-
- public
- property Control: TControl read fControl;
- property EventType: TutlEventType read fEventType;
- property Timestamp: Single read fTimestamp;
-
- constructor Create(
- const aControl: TControl;
- const aEventType: TutlEventType);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlMouseEventArgs = class(TutlWinControlEventArgs)
- private
- fButtons: TutlMouseButtons;
- fClientPos: TPoint;
- fScreenPos: TPoint;
-
- public
- property Buttons: TutlMouseButtons read fButtons;
- property ClientPos: TPoint read fClientPos;
- property ScreenPos: TPoint read fScreenPos;
-
- constructor Create(
- const aControl: TControl;
- const aEventType: TutlEventType;
- const aButtons: TutlMouseButtons;
- const aClientPos: TPoint);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlMouseWheelEventArgs = class(TutlWinControlEventArgs)
- private
- fWheelDelta: Integer;
- fClientPos: TPoint;
- fScreenPos: TPoint;
-
- public
- property WheelDelta: Integer read fWheelDelta;
- property ClientPos: TPoint read fClientPos;
- property ScreenPos: TPoint read fScreenPos;
-
- constructor Create(
- const aControl: TControl;
- const aWheelDelta: Integer;
- const aClientPos: TPoint);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlKeyEventArgs = class(TutlWinControlEventArgs)
- private
- fCharCode: WideChar;
- fKeyCode: Word;
-
- public
- property CharCode: WideChar read fCharCode;
- property KeyCode: Word read fKeyCode;
-
- constructor Create(
- const aControl: TControl;
- const aEventType: TutlEventType;
- const aCharCode: WideChar;
- const aKeyCode: Word);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlWindowEventArgs = class(TutlWinControlEventArgs)
- private
- fScreenRect: TRect;
- fClientWidth: Cardinal;
- fClientHeight: Cardinal;
-
- public
- property ScreenRect: TRect read fScreenRect;
- property ClientWidth: Cardinal read fClientWidth;
- property ClientHeight: Cardinal read fClientHeight;
-
- constructor Create(
- const aControl: TControl;
- const aEventType: TutlEventType;
- const aScreenRect: TRect;
- const aClientWidth: Cardinal;
- const aClientHeight: Cardinal);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlWinControlEventManager = class(
- TutlInterfacedObject
- , IutlObservable)
-
- public const
- EVENT_MOUSE_DOWN = 0;
- EVENT_MOUSE_UP = 1;
- EVENT_MOUSE_WHEEL_UP = 2;
- EVENT_MOUSE_WHEEL_DOWN = 3;
- EVENT_MOUSE_MOVE = 4;
- EVENT_MOUSE_ENTER = 5;
- EVENT_MOUSE_LEAVE = 6;
- EVENT_MOUSE_CLICK = 7;
- EVENT_MOUSE_DBL_CLICK = 8;
-
- EVENT_KEY_DOWN = 10;
- EVENT_KEY_REPEAT = 11;
- EVENT_KEY_UP = 12;
-
- EVENT_WINDOW_RESIZE = 15;
- EVENT_WINDOW_ACTIVATE = 16;
- EVENT_WINDOW_DEACTIVATE = 17;
-
- EVENTS_MOUSE: TutlEventTypes = [
- EVENT_MOUSE_DOWN,
- EVENT_MOUSE_UP,
- EVENT_MOUSE_WHEEL_UP,
- EVENT_MOUSE_WHEEL_DOWN,
- EVENT_MOUSE_MOVE,
- EVENT_MOUSE_ENTER,
- EVENT_MOUSE_LEAVE,
- EVENT_MOUSE_CLICK,
- EVENT_MOUSE_DBL_CLICK
- ];
- EVENTS_KEYBOARD: TutlEventTypes = [
- EVENT_KEY_DOWN,
- EVENT_KEY_REPEAT,
- EVENT_KEY_UP
- ];
- EVENTS_WINDOW: TutlEventTypes = [
- EVENT_WINDOW_RESIZE,
- EVENT_WINDOW_ACTIVATE,
- EVENT_WINDOW_DEACTIVATE
- ];
-
- public type
- TutlEventType = uutlEventManager.TutlEventType;
- TutlEventTypes = uutlEventManager.TutlEventTypes;
- TutlMouseButtons = uutlEventManager.TutlMouseButtons;
-
- TutlWinControlEventArgs = uutlEventManager.TutlWinControlEventArgs;
- TutlMouseEventArgs = uutlEventManager.TutlMouseEventArgs;
- TutlMouseWheelEventArgs = uutlEventManager.TutlMouseWheelEventArgs;
- TutlKeyEventArgs = uutlEventManager.TutlKeyEventArgs;
- TutlWindowEventArgs = uutlEventManager.TutlWindowEventArgs;
-
- private type
- TKeyboardState = record
- Modifiers: TShiftState;
- KeyState: array[Byte] of Boolean;
- end;
-
- TMouseState = record
- ScreenPos: TPoint;
- ClientPos: TPoint;
- Buttons: TutlMouseButtons;
- end;
-
- TWindowState = record
- Active: Boolean;
- ScreenRect: TRect;
- ClientWidth: Integer;
- ClientHeight: Integer;
- end;
-
- private
- fKeyboard: TKeyboardState;
- fMouse: TMouseState;
- fWindow: TWindowState;
- fEventListener: TutlEventListenerSet;
-
- procedure HandlerMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure HandlerMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure HandlerMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer);
- procedure HandlerMouseEnter (Sender: TObject);
- procedure HandlerMouseLeave (Sender: TObject);
- procedure HandlerClick (Sender: TObject);
- procedure HandlerDblClick (Sender: TObject);
- procedure HandlerMouseWheel (Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
-
- procedure HandlerKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
- procedure HandlerKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState);
-
- procedure HandlerResize (Sender: TObject);
- procedure HandlerActivate (Sender: TObject);
- procedure HandlerDeactivate (Sender: TObject);
-
- protected
- procedure RecordEvent(aEventArgs: IutlEventArgs); virtual;
- procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
-
- function CreateMouseEventArgs(
- aControl: TControl;
- aType: TutlEventType;
- aButtons: TutlMouseButtons;
- aClientPos: TPoint): IutlEventArgs; virtual;
-
- function CreateMouseWheelEventArgs(
- aControl: TControl;
- aDelta: Integer;
- aClientPos: TPoint): IutlEventArgs; virtual;
-
- function CreateKeyEventArgs(
- aControl: TControl;
- aType: TutlEventType;
- aKey: Word): IutlEventArgs; virtual;
-
- function CreateWindowEventArgs(
- aControl: TControl;
- aType: TutlEventType): IutlEventArgs; virtual;
-
- public { IutlObservable }
- procedure RegisterEventListener (aListener: IutlEventListener);
- procedure UnregisterEventListener(aListener: IutlEventListener);
-
- public
- property Keyboard: TKeyboardState read fKeyboard;
- property Mouse: TMouseState read fMouse;
- property Window: TWindowState read fWindow;
-
- procedure AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes);
-
- constructor Create;
- destructor Destroy; override;
- end;
-
- implementation
-
- uses
- LCLIntf, Forms,
- uutlKeyCodes;
-
- type
- TWinControlVisibilityClass = class(TWinControl)
- published
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnMouseEnter;
- property OnMouseLeave;
- property OnClick;
- property OnDblClick;
- end;
-
- TCustomFormVisibilityClass = class(TCustomForm)
- published
- property OnActivate;
- property OnDeactivate;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlWinControlEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlWinControlEventArgs.Create(const aControl: TControl; const aEventType: TutlEventType);
- begin
- inherited Create;
- fControl := aControl;
- fEventType := aEventType;
- fTimestamp := GetMicroTime / 1000000;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMouseEventArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlMouseEventArgs.Create(
- const aControl: TControl;
- const aEventType: TutlEventType;
- const aButtons: TutlMouseButtons;
- const aClientPos: TPoint);
- begin
- inherited Create(aControl, aEventType);
- fButtons := aButtons;
- fClientPos := aClientPos;
- fScreenPos := Control.ClientToScreen(fClientPos);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlMouseWheelEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlMouseWheelEventArgs.Create(
- const aControl: TControl;
- const aWheelDelta: Integer;
- const aClientPos: TPoint);
- begin
- if (aWheelDelta < 0)
- then inherited Create(aControl, TutlWinControlEventManager.EVENT_MOUSE_WHEEL_DOWN)
- else inherited Create(aControl, TutlWinControlEventManager.EVENT_MOUSE_WHEEL_UP);
- fWheelDelta := aWheelDelta;
- fClientPos := aClientPos;
- fScreenPos := Control.ClientToScreen(fClientPos);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlKeyEventArgs///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlKeyEventArgs.Create(
- const aControl: TControl;
- const aEventType: TutlEventType;
- const aCharCode: WideChar;
- const aKeyCode: Word);
- begin
- inherited Create(aControl, aEventType);
- fCharCode := aCharCode;
- fKeyCode := aKeyCode;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlWindowEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlWindowEventArgs.Create(
- const aControl: TControl;
- const aEventType: TutlEventType;
- const aScreenRect: TRect;
- const aClientWidth: Cardinal;
- const aClientHeight: Cardinal);
- begin
- inherited Create(aControl, aEventType);
- fScreenRect := aScreenRect;
- fClientWidth := aClientWidth;
- fClientHeight := aClientHeight;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlWinControlEventManager/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- begin
- DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_DOWN, [Button], Point(X, Y)));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_UP, [Button], Point(X, Y)));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- begin
- DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_MOVE, [], Point(X, Y)));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerMouseEnter(Sender: TObject);
- begin
- DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_ENTER, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerMouseLeave(Sender: TObject);
- begin
- DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_LEAVE, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerClick(Sender: TObject);
- begin
- DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerDblClick(Sender: TObject);
- begin
- DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_DBL_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerMouseWheel(Sender: TObject; Shift: TShiftState;
- WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
- begin
- DispatchEvent(self, CreateMouseWheelEventArgs(Sender as TControl, WheelDelta, MousePos));
- Handled := false;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- begin
- DispatchEvent(self, CreateKeyEventArgs(Sender as TControl, EVENT_KEY_DOWN, Key));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
- begin
- DispatchEvent(self, CreateKeyEventArgs(Sender as TControl, EVENT_KEY_UP, Key));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerResize(Sender: TObject);
- begin
- DispatchEvent(self, CreateWindowEventArgs(Sender as TControl, EVENT_WINDOW_RESIZE));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerActivate(Sender: TObject);
- begin
- DispatchEvent(self, CreateWindowEventArgs(Sender as TControl, EVENT_WINDOW_ACTIVATE));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.HandlerDeactivate(Sender: TObject);
- begin
- DispatchEvent(self, CreateWindowEventArgs(Sender as TControl, EVENT_WINDOW_DEACTIVATE));
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.RecordEvent(aEventArgs: IutlEventArgs);
- var
- mea: TutlMouseEventArgs;
- kea: TutlKeyEventArgs;
- wea: TutlWindowEventArgs;
-
- function GetPressedButtons: TutlMouseButtons;
- begin
- result := [];
- if (GetKeyState(VK_LBUTTON) < 0) then
- result := result + [mbLeft];
- if (GetKeyState(VK_RBUTTON) < 0) then
- result := result + [mbRight];
- if (GetKeyState(VK_MBUTTON) < 0) then
- result := result + [mbMiddle];
- if (GetKeyState(VK_XBUTTON1) < 0) then
- result := result + [mbExtra1];
- if (GetKeyState(VK_XBUTTON2) < 0) then
- result := result + [mbExtra2];
- end;
-
- begin
- if Supports(aEventArgs, TutlMouseEventArgs, mea) then begin
- fMouse.ClientPos := mea.ClientPos;
- fMouse.ScreenPos := mea.ScreenPos;
- case mea.EventType of
- EVENT_MOUSE_DOWN:
- fMouse.Buttons := fMouse.Buttons + mea.Buttons;
- EVENT_MOUSE_UP:
- fMouse.Buttons := fMouse.Buttons - mea.Buttons;
- EVENT_MOUSE_LEAVE:
- fMouse.Buttons := [];
- EVENT_MOUSE_ENTER:
- fMouse.Buttons := GetPressedButtons;
- end;
-
- end else if Supports(aEventArgs, TutlKeyEventArgs, kea) then begin
- case kea.EventType of
- EVENT_KEY_DOWN,
- EVENT_KEY_REPEAT: begin
- fKeyboard.KeyState[kea.KeyCode and $FF] := true;
- case kea.KeyCode of
- VK_SHIFT: Include(fKeyboard.Modifiers, ssShift);
- VK_MENU: Include(fKeyboard.Modifiers, ssAlt);
- VK_CONTROL: Include(fKeyboard.Modifiers, ssCtrl);
- end;
- end;
- EVENT_KEY_UP: begin
- fKeyboard.KeyState[kea.KeyCode and $FF] := false;
- case kea.KeyCode of
- VK_SHIFT: Exclude(fKeyboard.Modifiers, ssShift);
- VK_MENU: Exclude(fKeyboard.Modifiers, ssAlt);
- VK_CONTROL: Exclude(fKeyboard.Modifiers, ssCtrl);
- end;
- end;
- end;
- if ([ssCtrl, ssAlt] - fKeyboard.Modifiers = [])
- then include(fKeyboard.Modifiers, ssAltGr)
- else exclude(fKeyboard.Modifiers, ssAltGr);
-
- end else if Supports(aEventArgs, TutlWindowEventArgs, wea) then begin
- case wea.EventType of
- EVENT_WINDOW_ACTIVATE:
- fWindow.Active := true;
- EVENT_WINDOW_DEACTIVATE:
- fWindow.Active := false;
- EVENT_WINDOW_RESIZE: begin
- fWindow.ScreenRect := wea.ScreenRect;
- fWindow.ClientWidth := wea.ClientWidth;
- fWindow.ClientHeight := wea.ClientHeight;
- end;
- end;
- end;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
- begin
- RecordEvent(aEventArgs);
- fEventListener.DispatchEvent(aSender, aEventArgs);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlWinControlEventManager.CreateMouseEventArgs(
- aControl: TControl;
- aType: TutlEventType;
- aButtons: TutlMouseButtons;
- aClientPos: TPoint): IutlEventArgs;
- begin
- result := TutlMouseEventArgs.Create(
- aControl,
- aType,
- aButtons,
- aClientPos);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlWinControlEventManager.CreateMouseWheelEventArgs(
- aControl: TControl;
- aDelta: Integer;
- aClientPos: TPoint): IutlEventArgs;
- begin
- result := TutlMouseWheelEventArgs.Create(
- aControl,
- aDelta,
- aClientPos);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlWinControlEventManager.CreateKeyEventArgs(
- aControl: TControl;
- aType: TutlEventType;
- aKey: Word): IutlEventArgs;
- begin
- if (aType = EVENT_KEY_DOWN) and fKeyboard.KeyState[aKey and $FF] then
- aType := EVENT_KEY_REPEAT;
- result := TutlKeyEventArgs.Create(
- aControl,
- aType,
- VKCodeToCharCode(aKey, fKeyboard.Modifiers),
- aKey);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlWinControlEventManager.CreateWindowEventArgs(
- aControl: TControl;
- aType: TutlEventType): IutlEventArgs;
- var
- p0, p1: TPoint;
- begin
- with aControl do begin
- p0 := ClientToScreen(Point(0, 0));
- p1 := ClientToScreen(Point(Width, Height));
- end;
- result := TutlWindowEventArgs.Create(
- aControl,
- aType,
- Rect(p0.x, p0.y, p1.x, p1.y),
- (aControl as TWinControl).ClientWidth,
- (aControl as TWinControl).ClientHeight);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.RegisterEventListener(aListener: IutlEventListener);
- begin
- if Assigned(fEventListener) then
- fEventListener.Add(aListener);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.UnregisterEventListener(aListener: IutlEventListener);
- begin
- if Assigned(fEventListener) then
- fEventListener.Remove(aListener);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlWinControlEventManager.AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes);
- var
- ctl: TWinControlVisibilityClass;
- frm: TCustomFormVisibilityClass;
- begin
- ctl := TWinControlVisibilityClass(aControl);
-
- // mouse events
- if (EVENT_MOUSE_DOWN in aTypes) then ctl.OnMouseDown := @HandlerMouseDown;
- if (EVENT_MOUSE_UP in aTypes) then ctl.OnMouseUp := @HandlerMouseUp;
- if (EVENT_MOUSE_MOVE in aTypes) then ctl.OnMouseMove := @HandlerMouseMove;
- if (EVENT_MOUSE_ENTER in aTypes) then ctl.OnMouseEnter := @HandlerMouseEnter;
- if (EVENT_MOUSE_LEAVE in aTypes) then ctl.OnMouseLeave := @HandlerMouseLeave;
- if (EVENT_MOUSE_CLICK in aTypes) then ctl.OnClick := @HandlerClick;
- if (EVENT_MOUSE_DBL_CLICK in aTypes) then ctl.OnDblClick := @HandlerDblClick;
- if (EVENT_MOUSE_WHEEL_DOWN in aTypes) or
- (EVENT_MOUSE_WHEEL_UP in aTypes) then ctl.OnMouseWheel := @HandlerMouseWheel;
-
- // key events
- if (EVENT_KEY_DOWN in aTypes) then ctl.OnKeyDown := @HandlerKeyDown;
- if (EVENT_KEY_UP in aTypes) then ctl.OnKeyUp := @HandlerKeyUp;
-
- // window events
- if (EVENT_WINDOW_RESIZE in aTypes) then begin
- ctl.OnResize := @HandlerResize;
- fWindow.ClientWidth := ctl.ClientWidth;
- fWindow.ClientHeight := ctl.ClientHeight;
- end;
- if (aControl is TCustomForm) then begin
- frm := TCustomFormVisibilityClass(aControl);
- frm.KeyPreview := true;
- if (EVENT_WINDOW_ACTIVATE in aTypes) then frm.OnActivate := @HandlerActivate;
- if (EVENT_WINDOW_DEACTIVATE in aTypes) then frm.OnDeactivate := @HandlerDeactivate;
- end;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlWinControlEventManager.Create;
- begin
- inherited Create;
- fEventListener := TutlEventListenerSet.Create;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TutlWinControlEventManager.Destroy;
- begin
- FreeAndNil(fEventListener);
- inherited Destroy;
- end;
-
- end.
|