utils/uutlEventManager.pas

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;

  TutlMouseWheelEvent = class(TutlMouseEvent)
  protected
    function CreateInstance: TutlInputEvent; override;
    procedure Assign(const aEvent: TutlInputEvent); override;
  public
    WheelDelta: Integer;
    constructor Create(aType: TutlEventType; aWheelDelta: Integer; 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 aControl: TWinControl; 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
  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;

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;

{ TutlMouseWheelEvent }

function TutlMouseWheelEvent.CreateInstance: TutlInputEvent;
begin
  result := TutlMouseWheelEvent.Create(EventType, WheelDelta, ClientPos, ScreenPos);
end;

procedure TutlMouseWheelEvent.Assign(const aEvent: TutlInputEvent);
begin
  inherited Assign(aEvent);
  WheelDelta := (aEvent as TutlMouseWheelEvent).WheelDelta;
end;

constructor TutlMouseWheelEvent.Create(aType: TutlEventType; aWheelDelta: Integer; aClientPos, aScreenPos: TPoint);
begin
  inherited Create(aType, aClientPos, aScreenPos);
  WheelDelta := aWheelDelta;
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(TutlMouseWheelEvent.Create(MOUSE_WHEEL_DOWN, WheelDelta, MousePos, TWinControl(Sender).ClientToScreen(MousePos)))
  else
    QueuePush(TutlMouseWheelEvent.Create(MOUSE_WHEEL_UP, WheelDelta, 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 aControl: TWinControl; aEventMask: TutlEventTypes);
var
  ctl: TWinControlVisibilityClass;
  frm: TCustomFormVisibilityClass;
begin
  ctl := TWinControlVisibilityClass(aControl);

  // mouse events
  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;

  // key events
  if (KEY_DOWN          in aEventMask) then ctl.OnKeyDown    := @EventHandlerKeyDown;
  if (KEY_UP            in aEventMask) then ctl.OnKeyUp      := @EventHandlerKeyUp;

  // window events
  if (WINDOW_RESIZE     in aEventMask) then ctl.OnResize     := @EventHandlerResize;
  if Supports(aControl, TCustomFormVisibilityClass, frm) then begin
    frm.KeyPreview := true;
    if (WINDOW_ACTIVATE   in aEventMask) then frm.OnActivate   := @EventHandlerActivate;
    if (WINDOW_DEACTIVATE in aEventMask) then frm.OnDeactivate := @EventHandlerDeactivate;
  end;
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.