|
- 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, uutlGenerics, syncobjs, uutlTiming, Controls, Forms, uutlMessageThread, uutlMessages;
-
- type
- TutlEventType = (
- MOUSE_DOWN = 10,
- MOUSE_UP,
- MOUSE_WHEEL_UP,
- MOUSE_WHEEL_DOWN,
- MOUSE_MOVE,
- MOUSE_ENTER,
- MOUSE_LEAVE,
- MOUSE_CLICK,
- MOUSE_DBL_CLICK,
-
- KEY_DOWN = 20,
- KEY_REPEAT,
- KEY_UP,
-
- WINDOW_RESIZE = 30,
- WINDOW_ACTIVATE,
- WINDOW_DEACTIVATE
- );
- TutlEventTypes = set of TutlEventType;
-
- { TutlInputEvent }
-
- TutlInputEvent = class
- protected
- function CreateInstance: TutlInputEvent; virtual;
- procedure Assign(const aEvent: TutlInputEvent); virtual;
- public
- Timestamp: QWord;
- EventType: TutlEventType;
- function Clone: TutlInputEvent;
- constructor Create(aType: TutlEventType);
- end;
- TutlInputEventList = specialize TutlList<TutlInputEvent>;
-
- { TutlMouseEvent }
-
- TutlMouseEvent = class(TutlInputEvent)
- protected
- function CreateInstance: TutlInputEvent; override;
- procedure Assign(const aEvent: TutlInputEvent); override;
- public
- Button: TMouseButton;
- ClientPos,
- ScreenPos: TPoint;
- constructor Create(aType: TutlEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint);
- constructor Create(aType: TutlEventType; aClientPos, aScreenPos: TPoint);
- end;
-
- { TutlKeyEvent }
-
- TutlKeyEvent = class(TutlInputEvent)
- protected
- function CreateInstance: TutlInputEvent; override;
- procedure Assign(const aEvent: TutlInputEvent); override;
- public
- CharCode: WideChar;
- KeyCode: Word;
- constructor Create(aType: TutlEventType; aCharCode: WideChar; aKeyCode: Word);
- end;
-
- { TutlWindowEvent }
-
- TutlWindowEvent = class(TutlInputEvent)
- protected
- function CreateInstance: TutlInputEvent; override;
- procedure Assign(const aEvent: TutlInputEvent); override;
- public
- ScreenRect: TRect;
- ClientWidth,
- ClientHeight: Cardinal;
- constructor Create(aType: TutlEventType; aScreenRect: TRect; aClientWidth, aClientHeight: Cardinal);
- constructor Create(aType: TutlEventType; aScreenTopLeft: TPoint; aClientWidth, aClientHeight: Cardinal);
- end;
-
- { TutlEventManager }
-
- TutlInputEventHandler = procedure (Sender: TObject; Event: TutlInputEvent; var DoneEvent: boolean) of object;
- TMouseButtons = set of TMouseButton;
- TutlEventManager = class
- private type
- TInputState = record
- Keyboard: record
- Modifiers: TShiftState;
- KeyState: array[Byte] of Boolean;
- end;
- Mouse: record
- ScreenPos, ClientPos: TPoint;
- Buttons: TMouseButtons;
- end;
- Window: record
- Active: boolean;
- ScreenRect: TRect;
- ClientWidth: Integer;
- ClientHeight: Integer;
- end;
- end;
-
- TEventListener = class
- ThreadID: TThreadID;
- Synchronous: Boolean;
- Filter: TutlEventTypes;
- Handler: TutlInputEventHandler;
- end;
- TEventListenerList = specialize TutlList<TEventListener>;
-
- TInputEventMsg = class(TutlCallbackMsg)
- private
- fSender: TObject;
- fHandler: TutlInputEventHandler;
- fInputEvent: TutlInputEvent;
- public
- procedure ExecuteCallback; override;
- constructor Create(const aSender: TObject; const aHandler: TutlInputEventHandler; const aInputEvent: TutlInputEvent);
- destructor Destroy; override;
- end;
-
- TSyncInputEventMsg = class(TutlSyncCallbackMsg)
- private
- fSender: TObject;
- fHandler: TutlInputEventHandler;
- fInputEvent: TutlInputEvent;
- fDoneEvent: Boolean;
- public
- property DoneEvent: Boolean read fDoneEvent;
- procedure ExecuteCallback; override;
- constructor Create(const aSender: TObject; const aHandler: TutlInputEventHandler; const aInputEvent: TutlInputEvent);
- destructor Destroy; override;
- end;
-
- private
- fEventQueue: TutlInputEventList;
- fEventQueueLock: TCriticalSection;
- fListeners: TEventListenerList;
- protected
- fCanonicalState: TInputState;
- procedure EventHandlerMouseDown(Sender: TObject; Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer);
- procedure EventHandlerMouseUp(Sender: TObject; Button: TMouseButton; {%H-}Shift: TShiftState; X, Y: Integer);
- procedure EventHandlerMouseWheel(Sender: TObject; {%H-}Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
- procedure EventHandlerMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X, Y: Integer);
- procedure EventHandlerMouseEnter(Sender: TObject);
- procedure EventHandlerMouseLeave(Sender: TObject);
-
- procedure EventHandlerClick(Sender: TObject);
- procedure EventHandlerDblClick(Sender: TObject);
-
- procedure EventHandlerKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
- procedure EventHandlerKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
-
- procedure EventHandlerResize(Sender: TObject);
- procedure EventHandlerActivate(Sender: TObject);
- procedure EventHandlerDeactivate(Sender: TObject);
-
- function QueuePush(const aEvent: TutlInputEvent): TutlInputEvent;
-
- function DispatchEvent(const aEvent: TutlInputEvent): boolean;
- procedure RecordEvent(const aEvent: TutlInputEvent);
- public
- property CanonicalState: TInputState read fCanonicalState;
-
- procedure AttachEvents(const fControl: TCustomForm; aEventMask: TutlEventTypes);
- function IsKeyDown(const aChar: Char): Boolean;
-
- procedure RegisterListener(const aEventMask: TutlEventTypes; const aHandler: TutlInputEventHandler; const aSynchronous: Boolean = false);
- procedure UnregisterListener(const aHandler: TutlInputEventHandler);
-
- procedure DispatchEvents;
-
- constructor Create;
- destructor Destroy; override;
- end;
-
- function utlEventManager: TutlEventManager;
-
- const
- utlInput_Events_Mouse = [MOUSE_DOWN, MOUSE_UP, MOUSE_WHEEL_UP, MOUSE_WHEEL_DOWN, MOUSE_MOVE,
- MOUSE_ENTER, MOUSE_LEAVE, MOUSE_CLICK, MOUSE_DBL_CLICK];
- utlInput_Events_Keyboard = [KEY_DOWN, KEY_REPEAT, KEY_UP];
- utlInput_Events_Window = [WINDOW_RESIZE, WINDOW_ACTIVATE, WINDOW_DEACTIVATE];
- utlInput_Events_All = utlInput_Events_Mouse+utlInput_Events_Keyboard+utlInput_Events_Window;
-
- implementation
-
- uses uutlKeyCodes, uutlLogger, LCLIntf;
-
- type
- TCustomFormVisibilityClass = class(TCustomForm)
- published
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnMouseEnter;
- property OnMouseLeave;
- property OnActivate;
- property OnDeactivate;
- property OnClick;
- property OnDblClick;
- end;
-
- var
- utlEventManager_Singleton: TutlEventManager;
-
- function utlEventManager: TutlEventManager;
- begin
- if not Assigned(utlEventManager_Singleton) then
- utlEventManager_Singleton := TutlEventManager.Create;
- result := utlEventManager_Singleton;
- end;
-
- { TSyncInputEventMsg }
-
- procedure TutlEventManager.TSyncInputEventMsg.ExecuteCallback;
- begin
- fHandler(fSender, fInputEvent, fDoneEvent);
- end;
-
- constructor TutlEventManager.TSyncInputEventMsg.Create(const aSender: TObject;
- const aHandler: TutlInputEventHandler; const aInputEvent: TutlInputEvent);
- begin
- inherited Create;
- fSender := aSender;
- fInputEvent := aInputEvent.Clone;
- fHandler := aHandler;
- fDoneEvent := false;
- end;
-
- destructor TutlEventManager.TSyncInputEventMsg.Destroy;
- begin
- FreeAndNil(fInputEvent);
- inherited Destroy;
- end;
-
- { TInputEventMsg }
-
- procedure TutlEventManager.TInputEventMsg.ExecuteCallback;
- var
- done: Boolean;
- begin
- done := false;
- fHandler(fSender, fInputEvent, done);
- end;
-
- constructor TutlEventManager.TInputEventMsg.Create(const aSender: TObject;
- const aHandler: TutlInputEventHandler; const aInputEvent: TutlInputEvent);
- begin
- inherited Create;
- fSender := aSender;
- fInputEvent := aInputEvent.Clone;
- fHandler := aHandler;
- end;
-
- destructor TutlEventManager.TInputEventMsg.Destroy;
- begin
- FreeAndNil(fInputEvent);
- inherited Destroy;
- end;
-
- { TutlInputEvent }
-
- function TutlInputEvent.CreateInstance: TutlInputEvent;
- begin
- result := TutlInputEvent.Create(EventType);
- end;
-
- procedure TutlInputEvent.Assign(const aEvent: TutlInputEvent);
- begin
- EventType := aEvent.EventType;
- Timestamp := aEvent.Timestamp;
- end;
-
- function TutlInputEvent.Clone: TutlInputEvent;
- begin
- result := CreateInstance;
- result.Assign(self);
- end;
-
- constructor TutlInputEvent.Create(aType: TutlEventType);
- begin
- inherited Create;
- Timestamp:= GetMicroTime;
- EventType:= aType;
- end;
-
- { TutlMouseEvent }
-
- function TutlMouseEvent.CreateInstance: TutlInputEvent;
- begin
- result := TutlMouseEvent.Create(EventType, ClientPos, ScreenPos);
- end;
-
- procedure TutlMouseEvent.Assign(const aEvent: TutlInputEvent);
- var
- e: TutlMouseEvent;
- begin
- inherited Assign(aEvent);
- e := aEvent as TutlMouseEvent;
- Button := e.Button;
- ClientPos := e.ClientPos;
- ScreenPos := e.ScreenPos;
- end;
-
- constructor TutlMouseEvent.Create(aType: TutlEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint);
- begin
- inherited Create(aType);
- Button:= aButton;
- ClientPos:= aClientPos;
- ScreenPos:= aScreenPos;
- end;
-
- constructor TutlMouseEvent.Create(aType: TutlEventType; aClientPos, aScreenPos: TPoint);
- begin
- inherited Create(aType);
- ClientPos:= aClientPos;
- ScreenPos:= aScreenPos;
- end;
-
- { TutlKeyEvent }
-
- function TutlKeyEvent.CreateInstance: TutlInputEvent;
- begin
- result := TutlKeyEvent.Create(EventType, CharCode, KeyCode);
- end;
-
- procedure TutlKeyEvent.Assign(const aEvent: TutlInputEvent);
- var
- e: TutlKeyEvent;
- begin
- inherited Assign(aEvent);
- e := (aEvent as TutlKeyEvent);
- CharCode := e.CharCode;
- KeyCode := e.KeyCode;
- end;
-
- constructor TutlKeyEvent.Create(aType: TutlEventType; aCharCode: WideChar; aKeyCode: Word);
- begin
- inherited Create(aType);
- CharCode:= aCharCode;
- KeyCode:= aKeyCode;
- end;
-
- { TutlWindowEvent }
-
- function TutlWindowEvent.CreateInstance: TutlInputEvent;
- begin
- result := TutlWindowEvent.Create(EventType, ScreenRect, ClientWidth, ClientHeight);
- end;
-
- procedure TutlWindowEvent.Assign(const aEvent: TutlInputEvent);
- var
- e: TutlWindowEvent;
- begin
- inherited Assign(aEvent);
- e := (aEvent as TutlWindowEvent);
- ScreenRect := e.ScreenRect;
- ClientWidth := e.ClientWidth;
- ClientHeight := e.ClientHeight;
- end;
-
- constructor TutlWindowEvent.Create(aType: TutlEventType; aScreenRect: TRect; aClientWidth,
- aClientHeight: Cardinal);
- begin
- inherited Create(aType);
- ScreenRect:= aScreenRect;
- ClientWidth:= aClientWidth;
- ClientHeight:= aClientHeight;
- end;
-
- constructor TutlWindowEvent.Create(aType: TutlEventType; aScreenTopLeft: TPoint; aClientWidth, aClientHeight: Cardinal);
- begin
- inherited Create(aType);
- ClientWidth:= aClientWidth;
- ClientHeight:= aClientHeight;
-
- ScreenRect.TopLeft:= aScreenTopLeft;
- ScreenRect.BottomRight:= aScreenTopLeft;
- inc(ScreenRect.Right, ClientWidth);
- inc(ScreenRect.Bottom, ClientHeight);
- end;
-
- { TutlEventManager }
-
- {$REGION EventHandler}
- procedure TutlEventManager.EventHandlerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- QueuePush(TutlMouseEvent.Create(MOUSE_DOWN, Button, Point(X,Y), TWinControl(Sender).ClientToScreen(Point(X,Y))));
- end;
-
- procedure TutlEventManager.EventHandlerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
- begin
- QueuePush(TutlMouseEvent.Create(MOUSE_MOVE, Point(X,Y), TWinControl(Sender).ClientToScreen(Point(X,Y))));
- end;
-
- procedure TutlEventManager.EventHandlerMouseEnter(Sender: TObject);
- begin
- QueuePush(TutlMouseEvent.Create(MOUSE_ENTER, TWinControl(Sender).ScreenToClient(Mouse.CursorPos), Mouse.CursorPos));
- end;
-
- procedure TutlEventManager.EventHandlerMouseLeave(Sender: TObject);
- begin
- QueuePush(TutlMouseEvent.Create(MOUSE_LEAVE, TWinControl(Sender).ScreenToClient(Mouse.CursorPos), Mouse.CursorPos));
- end;
-
- procedure TutlEventManager.EventHandlerClick(Sender: TObject);
- begin
- QueuePush(TutlMouseEvent.Create(MOUSE_CLICK, TWinControl(Sender).ScreenToClient(Mouse.CursorPos), Mouse.CursorPos));
- end;
-
- procedure TutlEventManager.EventHandlerDblClick(Sender: TObject);
- begin
- QueuePush(TutlMouseEvent.Create(MOUSE_DBL_CLICK, TWinControl(Sender).ScreenToClient(Mouse.CursorPos), Mouse.CursorPos));
- end;
-
- procedure TutlEventManager.EventHandlerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- QueuePush(TutlMouseEvent.Create(MOUSE_UP, Button, Point(X,Y), TWinControl(Sender).ClientToScreen(Point(X,Y))));
- end;
-
- procedure TutlEventManager.EventHandlerMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
- begin
- if WheelDelta < 0 then
- QueuePush(TutlMouseEvent.Create(MOUSE_WHEEL_DOWN, MousePos, TWinControl(Sender).ClientToScreen(MousePos)))
- else
- QueuePush(TutlMouseEvent.Create(MOUSE_WHEEL_UP, MousePos, TWinControl(Sender).ClientToScreen(MousePos)));
- Handled:= false;
- end;
-
- procedure TutlEventManager.EventHandlerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
- var
- ch: WideChar;
- begin
- ch:= VKCodeToCharCode(Key, fCanonicalState.Keyboard.Modifiers);
-
- if fCanonicalState.Keyboard.KeyState[Key and $FF] then
- QueuePush(TutlKeyEvent.Create(KEY_REPEAT, ch, Key))
- else
- QueuePush(TutlKeyEvent.Create(KEY_DOWN, ch, Key));
- end;
-
- procedure TutlEventManager.EventHandlerKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
- var
- ch: WideChar;
- begin
- ch:= VKCodeToCharCode(Key, fCanonicalState.Keyboard.Modifiers);
- QueuePush(TutlKeyEvent.Create(KEY_UP, ch, Key));
- end;
-
- procedure TutlEventManager.EventHandlerResize(Sender: TObject);
- var
- w: TControl;
- begin
- w := (Sender as TControl);
- QueuePush(TutlWindowEvent.Create(WINDOW_RESIZE, w.ClientToScreen(Point(0,0)), w.ClientWidth, w.ClientHeight));
- end;
-
- procedure TutlEventManager.EventHandlerActivate(Sender: TObject);
- var
- w: TControl;
- begin
- w := (Sender as TControl);
- QueuePush(TutlWindowEvent.Create(WINDOW_ACTIVATE, w.ClientToScreen(Point(0,0)), w.ClientWidth, w.ClientHeight));
- end;
-
- procedure TutlEventManager.EventHandlerDeactivate(Sender: TObject);
- var
- w: TControl;
- begin
- w := (Sender as TControl);
- QueuePush(TutlWindowEvent.Create(WINDOW_DEACTIVATE, w.ClientToScreen(Point(0,0)), w.ClientWidth, w.ClientHeight));
- end;
- {$ENDREGION}
-
- function TutlEventManager.QueuePush(const aEvent: TutlInputEvent): TutlInputEvent;
- begin
- fEventQueueLock.Acquire;
- try
- if Assigned(fEventQueue) then
- fEventQueue.Add(aEvent);
- Result:= aEvent;
- finally
- fEventQueueLock.Release;
- end;
- end;
-
- function TutlEventManager.DispatchEvent(const aEvent: TutlInputEvent): boolean;
- var
- i: integer;
- ls: TEventListener;
- msg: TSyncInputEventMsg;
- begin
- Result:= false;
- for i:= 0 to fListeners.Count-1 do begin
- if aEvent.EventType in fListeners[i].Filter then begin
- ls := fListeners[i];
- if (GetCurrentThreadId <> ls.ThreadID) then begin
- if (ls.Synchronous) then begin
- msg := TSyncInputEventMsg.Create(self, ls.Handler, aEvent);
- if utlSendMessage(ls.ThreadID, msg, 5000) = wrSignaled then begin
- result := msg.DoneEvent;
- msg.Free; //only free on wrSignal, otherwise thread will free message
- end
- end else
- utlPostMessage(ls.ThreadID, TInputEventMsg.Create(self, ls.Handler, aEvent));
- end else
- fListeners[i].Handler(Self, aEvent, Result);
- end;
- if Result then
- break;
- end;
- end;
-
- procedure TutlEventManager.RecordEvent(const aEvent: TutlInputEvent);
-
- function GetPressedButtons: TMouseButtons;
- 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 aEvent is TutlMouseEvent then
- with TutlMouseEvent(aEvent) do begin
- fCanonicalState.Mouse.ClientPos := ClientPos;
- fCanonicalState.Mouse.ScreenPos := ScreenPos;
- case EventType of
- MOUSE_DOWN:
- Include(fCanonicalState.Mouse.Buttons, Button);
- MOUSE_UP:
- Exclude(fCanonicalState.Mouse.Buttons, Button);
- MOUSE_LEAVE:
- fCanonicalState.Mouse.Buttons := [];
- MOUSE_ENTER:
- fCanonicalState.Mouse.Buttons := GetPressedButtons;
- MOUSE_CLICK,
- MOUSE_DBL_CLICK,
- MOUSE_MOVE,
- MOUSE_WHEEL_DOWN,
- MOUSE_WHEEL_UP: ; //nothing to record here
- end;
- end
- else if aEvent is TutlKeyEvent then
- with TutlKeyEvent(aEvent) do begin
- case EventType of
- KEY_DOWN,
- KEY_REPEAT: begin
- fCanonicalState.Keyboard.KeyState[KeyCode and $FF]:= true;
- case KeyCode of
- VK_SHIFT: include(fCanonicalState.Keyboard.Modifiers, ssShift);
- VK_MENU: include(fCanonicalState.Keyboard.Modifiers, ssAlt);
- VK_CONTROL: include(fCanonicalState.Keyboard.Modifiers, ssCtrl);
- end;
- end;
- KEY_UP: begin
- fCanonicalState.Keyboard.KeyState[KeyCode and $FF]:= false;
- case KeyCode of
- VK_SHIFT: Exclude(fCanonicalState.Keyboard.Modifiers, ssShift);
- VK_MENU: Exclude(fCanonicalState.Keyboard.Modifiers, ssAlt);
- VK_CONTROL: Exclude(fCanonicalState.Keyboard.Modifiers, ssCtrl);
- end;
- end;
- end;
- if [ssCtrl, ssAlt] - fCanonicalState.Keyboard.Modifiers = [] then
- include(fCanonicalState.Keyboard.Modifiers, ssAltGr)
- else
- exclude(fCanonicalState.Keyboard.Modifiers, ssAltGr);
- end
- else if aEvent is TutlWindowEvent then
- with TutlWindowEvent(aEvent) do begin
- case EventType of
- WINDOW_ACTIVATE: fCanonicalState.Window.Active:= true;
- WINDOW_DEACTIVATE: fCanonicalState.Window.Active:= true;
- WINDOW_RESIZE: begin
- fCanonicalState.Window.ScreenRect := ScreenRect;
- fCanonicalState.Window.ClientWidth := ClientWidth;
- fCanonicalState.Window.ClientHeight := ClientHeight;
- end;
- end;
- end
- end;
-
- procedure TutlEventManager.DispatchEvents;
- var
- i: integer;
- begin
- fEventQueueLock.Acquire;
- try
- if Assigned(fEventQueue) then begin
- //process ALL events
- for i:= 0 to fEventQueue.Count-1 do begin
- DispatchEvent(fEventQueue[i]);
- RecordEvent(fEventQueue[i]);
- end;
- //now that we're done, free them
- fEventQueue.Clear;
- end;
- finally
- fEventQueueLock.Release;
- end;
- end;
-
- procedure TutlEventManager.AttachEvents(const fControl: TCustomForm; aEventMask: TutlEventTypes);
- var
- ctl: TCustomFormVisibilityClass;
- begin
- ctl:= TCustomFormVisibilityClass(fControl);
- ctl.KeyPreview:= true;
- if MOUSE_DOWN in aEventMask then ctl.OnMouseDown:= @EventHandlerMouseDown;
- if MOUSE_UP in aEventMask then ctl.OnMouseUp:= @EventHandlerMouseUp;
- if (MOUSE_WHEEL_DOWN in aEventMask) or
- (MOUSE_WHEEL_UP in aEventMask) then ctl.OnMouseWheel:= @EventHandlerMouseWheel;
- if MOUSE_MOVE in aEventMask then ctl.OnMouseMove:= @EventHandlerMouseMove;
- if MOUSE_ENTER in aEventMask then ctl.OnMouseEnter := @EventHandlerMouseEnter;
- if MOUSE_LEAVE in aEventMask then ctl.OnMouseLeave := @EventHandlerMouseLeave;
- if MOUSE_CLICK in aEventMask then ctl.OnClick := @EventHandlerClick;
- if MOUSE_DBL_CLICK in aEventMask then ctl.OnDblClick := @EventHandlerDblClick;
-
- if KEY_DOWN in aEventMask then ctl.OnKeyDown:= @EventHandlerKeyDown;
- if KEY_UP in aEventMask then ctl.OnKeyUp:= @EventHandlerKeyUp;
-
- if WINDOW_RESIZE in aEventMask then ctl.OnResize:= @EventHandlerResize;
- if WINDOW_ACTIVATE in aEventMask then ctl.OnActivate:= @EventHandlerActivate;
- if WINDOW_DEACTIVATE in aEventMask then ctl.OnDeactivate:= @EventHandlerDeactivate;
- end;
-
- function TutlEventManager.IsKeyDown(const aChar: Char): Boolean;
- begin
- result := CanonicalState.Keyboard.KeyState[Ord(UpCase(aChar))];
- end;
-
- procedure TutlEventManager.RegisterListener(const aEventMask: TutlEventTypes;
- const aHandler: TutlInputEventHandler; const aSynchronous: Boolean);
- var
- ls: TEventListener;
- begin
- UnregisterListener(aHandler);
- ls:= TEventListener.Create;
- try
- ls.Filter := aEventMask;
- ls.Handler := aHandler;
- ls.ThreadID := GetCurrentThreadId;
- ls.Synchronous := aSynchronous;
- fListeners.Add(ls);
- except
- ls.Free;
- end;
- end;
-
- procedure TutlEventManager.UnregisterListener(const aHandler: TutlInputEventHandler);
- var
- i: integer;
- m1, m2: TMethod;
- begin
- m1 := TMethod(aHandler);
- for i:= fListeners.Count-1 downto 0 do begin
- m2 := TMethod(fListeners[i].Handler);
- if (m1.Data = m2.Data) and
- (m2.Code = m2.Code)then
- fListeners.Delete(i);
- end;
- end;
-
- constructor TutlEventManager.Create;
- begin
- inherited Create;
- fEventQueue:= TutlInputEventList.Create(true);
- fEventQueueLock:= TCriticalSection.Create;
- fListeners:= TEventListenerList.Create(true);
- end;
-
- destructor TutlEventManager.Destroy;
- begin
- FreeAndNil(fListeners);
- fEventQueueLock.Acquire;
- try
- fEventQueue.Clear;
- FreeAndNil(fEventQueue);
- finally
- fEventQueueLock.Release;
- end;
- FreeAndNil(fEventQueueLock);
- inherited Destroy;
- end;
-
- finalization
- if Assigned(utlEventManager_Singleton) then
- FreeAndNil(utlEventManager_Singleton);
-
- end.
|