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, syncobjs, Controls,
  uutlGenerics;

type
  TutlEventType     = 0..63;
  TutlEventTypeMask = UInt64;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEvent = class
  public
    EventType: TutlEventType;
    Timestamp: QWord;

    function Clone: TutlEvent;
    procedure Assign(const aEvent: TutlEvent); virtual;
    constructor Create; virtual;
  end;
  TutlEventClass = class of TutlEvent;
  TutlEventList = specialize TutlList<TutlEvent>;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventListener = class(TObject)
  public
    function DispatchEvent(const aEvent: TutlEvent): Boolean; virtual;
  end;
  TutlEventListenerSet = specialize TutlHashSet<TutlEventListener>;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventHandler = procedure(aSender: TObject; aEvent: TutlEvent) of object;
  TutlCallbackEventListener = class(TutlEventListener)
  public
    Callback: TutlEventHandler;
    Filter: TutlEventTypeMask;
    function DispatchEvent(const aEvent: TutlEvent): Boolean; override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlEventManager = class(TObject)
  private
    fEventQueue:      TutlEventList;
    fEventQueueLock:  TCriticalSection;
    fEventListener:   TutlEventListenerSet;

    procedure DispatchEvent(const aEvent: TutlEvent);
  protected
    procedure PushEvent(const aEvent: TutlEvent); virtual;
    procedure RecordEvent(const aEvent: TutlEvent); virtual;
  public
    procedure RegisterListener(const aEventMask: TutlEventTypeMask; const aCallback: TutlEventHandler);
    procedure RegisterListener(const aListener: TutlEventListener);

    procedure UnregisterListener(const aHandler: TutlEventHandler);
    procedure UnregisterListener(const aListener: TutlEventListener);

    procedure DispatchEvents;

    constructor Create;
    destructor Destroy; override;

  public
    class function MakeMask    (const aTypes: array of TutlEventType): TutlEventTypeMask;
    class function CombineMasks(const aMasks: array of TutlEventTypeMask): TutlEventTypeMask;
    class function MaskHasType (const aMask: TutlEventTypeMask; const aType: TutlEventType): Boolean; inline;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlMouseEvent = class(TutlEvent)
  public
    Button: TMouseButton;
    ClientPos: TPoint;
    ScreenPos: TPoint;
    procedure Assign(const aEvent: TutlEvent); override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlMouseWheelEvent = class(TutlEvent)
  public
    WheelDelta: Integer;
    ClientPos: TPoint;
    ScreenPos: TPoint;
    procedure Assign(const aEvent: TutlEvent); override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlKeyEvent = class(TutlEvent)
  public
    CharCode: WideChar;
    KeyCode: Word;
    procedure Assign(const aEvent: TutlEvent); override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlWindowEvent = class(TutlEvent)
  public
    ScreenRect: TRect;
    ClientWidth: Cardinal;
    ClientHeight: Cardinal;
    procedure Assign(const aEvent: TutlEvent); override;
  end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TutlWinControlEventManager = class(TutlEventManager)
  public type
    TMouseButtons = set of TMouseButton;
    TKeyboardState = record
      Modifiers: TShiftState;
      KeyState: array[Byte] of Boolean;
    end;
    TMouseState = record
      ScreenPos, ClientPos: TPoint;
      Buttons: TMouseButtons;
    end;
    TWindowState = record
      Active: boolean;
      ScreenRect: TRect;
      ClientWidth: Integer;
      ClientHeight: Integer;
    end;

  public const
    MOUSE_DOWN        =  0;
    MOUSE_UP          =  1;
    MOUSE_WHEEL_UP    =  2;
    MOUSE_WHEEL_DOWN  =  3;
    MOUSE_MOVE        =  4;
    MOUSE_ENTER       =  5;
    MOUSE_LEAVE       =  6;
    MOUSE_CLICK       =  7;
    MOUSE_DBL_CLICK   =  8;

    KEY_DOWN          = 10;
    KEY_REPEAT        = 11;
    KEY_UP            = 12;

    WINDOW_RESIZE     = 15;
    WINDOW_ACTIVATE   = 16;
    WINDOW_DEACTIVATE = 17;

    EVENTS_MOUSE: TutlEventTypeMask =
      (1 shl MOUSE_DOWN)        or
      (1 shl MOUSE_UP)          or
      (1 shl MOUSE_WHEEL_UP)    or
      (1 shl MOUSE_WHEEL_DOWN)  or
      (1 shl MOUSE_MOVE)        or
      (1 shl MOUSE_ENTER)       or
      (1 shl MOUSE_LEAVE)       or
      (1 shl MOUSE_CLICK)       or
      (1 shl MOUSE_DBL_CLICK);
    EVENTS_KEYBOARD: TutlEventTypeMask =
      (1 shl KEY_DOWN)          or
      (1 shl KEY_REPEAT)        or
      (1 shl KEY_UP);
    EVENTS_WINDOW: TutlEventTypeMask =
      (1 shl WINDOW_RESIZE)     or
      (1 shl WINDOW_ACTIVATE)   or
      (1 shl WINDOW_DEACTIVATE);
  private
    fKeyboard: TKeyboardState;
    fMouse: TMouseState;
    fWindow: TWindowState;

  private
    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(const aEvent: TutlEvent); override;

  protected
    function CreateMouseEvent     (aEvent: TutlMouseEvent; aType: TutlEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint): TutlMouseEvent; virtual;
    function CreateMouseWheelEvent(aEvent: TutlMouseWheelEvent; aSender: TWinControl; aDelta: Integer; aClientPos: TPoint): TutlMouseWheelEvent; virtual;
    function CreateKeyEvent       (aEvent: TutlKeyEvent; aType: TutlEventType; aKey: Word): TutlKeyEvent; virtual;
    function CreateWindowEvent    (aEvent: TutlWindowEvent; aType: TutlEventType; aSender: TControl): TutlWindowEvent; virtual;

  public
    property Keyboard: TKeyboardState read fKeyboard;
    property Mouse:    TMouseState    read fMouse;
    property Window:   TWindowState   read fWindow;

    procedure AttachEvents(const aControl: TWinControl; const aMask: TutlEventTypeMask);
  end;

implementation

uses
  LCLIntf, Forms,
  uutlTiming, uutlConversion, 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;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEvent.Clone: TutlEvent;
begin
  result := TutlEventClass(ClassType).Create;
  result.Assign(self);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEvent.Assign(const aEvent: TutlEvent);
begin
  Timestamp := aEvent.Timestamp;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEvent.Create;
begin
  inherited Create;
  Timestamp := GetMicroTime;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventListener//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlEventListener.DispatchEvent(const aEvent: TutlEvent): Boolean;
begin
  result := false;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlCallbackEventListener///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlCallbackEventListener.DispatchEvent(const aEvent: TutlEvent): Boolean;
begin
  result := inherited DispatchEvent(aEvent);
  if TutlEventManager.MaskHasType(Filter, aEvent.EventType) then
     Callback(self, aEvent);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlEventManager///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventManager.DispatchEvent(const aEvent: TutlEvent);
var
  l: TutlEventListener;
begin
  for l in fEventListener do begin
    if l.DispatchEvent(aEvent) then
       break;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventManager.PushEvent(const aEvent: TutlEvent);
begin
  fEventQueueLock.Enter;
  try
    if Assigned(fEventQueue) then
       fEventQueue.Add(aEvent)
    else if Assigned(aEvent) then
       aEvent.Free;
  finally
    fEventQueueLock.Leave;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventManager.RecordEvent(const aEvent: TutlEvent);
begin
  // DUMMY
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventManager.RegisterListener(const aEventMask: TutlEventTypeMask; const aCallback: TutlEventHandler);
var
  l: TutlCallbackEventListener;
begin
  UnregisterListener(aCallback);
  l := TutlCallbackEventListener.Create;
  try
    l.Filter   := aEventMask;
    l.Callback := aCallback;
    RegisterListener(l);
  except
    FreeAndNil(l);
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventManager.RegisterListener(const aListener: TutlEventListener);
begin
  fEventListener.Add(aListener);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventManager.UnregisterListener(const aHandler: TutlEventHandler);
var
  i: Integer;
  m1, m2: TMethod;
  cel: TutlCallbackEventListener;
begin
  m1 := TMethod(aHandler);
  for i := fEventListener.Count-1 downto 0 do
    if Supports(fEventListener[i], TutlCallbackEventListener, cel) then begin
      m2 := TMethod(cel.Callback);
      if (m1.Data = m2.Data) and
         (m1.Code = m2.Code) then
         fEventListener.Delete(i);
    end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventManager.UnregisterListener(const aListener: TutlEventListener);
begin
  fEventListener.Remove(aListener);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlEventManager.DispatchEvents;
var
  e: TutlEvent;
begin
  fEventQueueLock.Acquire;
  try
    if Assigned(fEventQueue) then begin
      for e in fEventQueue do begin
        DispatchEvent(e);
        RecordEvent(e);
      end;
      fEventQueue.Clear;
    end;
  finally
    fEventQueueLock.Release;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TutlEventManager.Create;
begin
  inherited Create;
  fEventListener  := TutlEventListenerSet.Create(true);
  fEventQueue     := TutlEventList.Create(true);
  fEventQueueLock := TCriticalSection.Create;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TutlEventManager.Destroy;
begin
  fEventQueueLock.Enter;
  try
    FreeAndNil(fEventQueue);
  finally
    fEventQueueLock.Leave;
  end;
  FreeAndNil(fEventQueueLock);
  FreeAndNil(fEventListener);
  inherited Destroy;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEventManager.MakeMask(const aTypes: array of TutlEventType): TutlEventTypeMask;
var
  e: TutlEventType;
begin
  result := 0;
  for e in aTypes do
    result := result or (1 shl e);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEventManager.CombineMasks(const aMasks: array of TutlEventTypeMask): TutlEventTypeMask;
var
  m: TutlEventTypeMask;
begin
  result := 0;
  for m in aMasks do
    result := result or m;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlEventManager.MaskHasType(const aMask: TutlEventTypeMask; const aType: TutlEventType): Boolean;
begin
  result := ((aMask and (1 shl aType)) <> 0);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMouseEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMouseEvent.Assign(const aEvent: TutlEvent);
var
  me: TutlMouseEvent;
begin
  inherited Assign(aEvent);
  if Supports(aEvent, TutlMouseEvent, me) then begin
    Button    := me.Button;
    ClientPos := me.ClientPos;
    ScreenPos := me.ScreenPos;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlMouseWheelEvent////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlMouseWheelEvent.Assign(const aEvent: TutlEvent);
var
  mwe: TutlMouseWheelEvent;
begin
  inherited Assign(aEvent);
  if Supports(aEvent, TutlMouseWheelEvent, mwe) then begin
    WheelDelta := mwe.WheelDelta;
    ClientPos  := mwe.ClientPos;
    ScreenPos  := mwe.ScreenPos;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlKeyEvent///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlKeyEvent.Assign(const aEvent: TutlEvent);
var
  ke: TutlKeyEvent;
begin
  inherited Assign(aEvent);
  if Supports(aEvent, TutlKeyEvent, ke) then begin
    CharCode := ke.CharCode;
    KeyCode  := ke.KeyCode;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlWindowEvent////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWindowEvent.Assign(const aEvent: TutlEvent);
var
  we: TutlWindowEvent;
begin
  inherited Assign(aEvent);
  if Supports(aEvent, TutlWindowEvent, we) then begin
    ScreenRect   := we.ScreenRect;
    ClientWidth  := we.ClientWidth;
    ClientHeight := we.ClientHeight;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlWinControlEventManager/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  PushEvent(CreateMouseEvent(nil, MOUSE_DOWN, Button, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y))));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  PushEvent(CreateMouseEvent(nil, MOUSE_UP, Button, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y))));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  PushEvent(CreateMouseEvent(nil, MOUSE_MOVE, mbLeft, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y))));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseEnter(Sender: TObject);
begin
  PushEvent(CreateMouseEvent(nil, MOUSE_ENTER, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseLeave(Sender: TObject);
begin
  PushEvent(CreateMouseEvent(nil, MOUSE_LEAVE, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerClick(Sender: TObject);
begin
  PushEvent(CreateMouseEvent(nil, MOUSE_CLICK, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerDblClick(Sender: TObject);
begin
  PushEvent(CreateMouseEvent(nil, MOUSE_DBL_CLICK, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
  PushEvent(CreateMouseWheelEvent(nil, TWinControl(Sender), WheelDelta, MousePos));
  Handled := false;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  PushEvent(CreateKeyEvent(nil, KEY_DOWN, Key));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  PushEvent(CreateKeyEvent(nil, KEY_UP, Key));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerResize(Sender: TObject);
begin
  PushEvent(CreateWindowEvent(nil, WINDOW_RESIZE, TControl(Sender)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerActivate(Sender: TObject);
begin
  PushEvent(CreateWindowEvent(nil, WINDOW_ACTIVATE, TControl(Sender)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.HandlerDeactivate(Sender: TObject);
begin
  PushEvent(CreateWindowEvent(nil, WINDOW_DEACTIVATE, TControl(Sender)));
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.RecordEvent(const aEvent: TutlEvent);
var
  me: TutlMouseEvent;
  ke: TutlKeyEvent;
  we: TutlWindowEvent;

  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
  inherited RecordEvent(aEvent);
  if Supports(aEvent, TutlMouseEvent, me) then begin
    fMouse.ClientPos := me.ClientPos;
    fMouse.ScreenPos := me.ScreenPos;
    case me.EventType of
      MOUSE_DOWN:
        Include(fMouse.Buttons, me.Button);
      MOUSE_UP:
        Exclude(fMouse.Buttons, me.Button);
      MOUSE_LEAVE:
        fMouse.Buttons := [];
      MOUSE_ENTER:
        fMouse.Buttons := GetPressedButtons;
    end;
  end else if Supports(aEvent, TutlKeyEvent, ke) then begin
    case ke.EventType of
      KEY_DOWN,
      KEY_REPEAT: begin
        fKeyboard.KeyState[ke.KeyCode and $FF] := true;
        case ke.KeyCode of
          VK_SHIFT:   include(fKeyboard.Modifiers, ssShift);
          VK_MENU:    include(fKeyboard.Modifiers, ssAlt);
          VK_CONTROL: include(fKeyboard.Modifiers, ssCtrl);
        end;
      end;
      KEY_UP: begin
        fKeyboard.KeyState[ke.KeyCode and $FF] := false;
        case ke.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(aEvent, TutlWindowEvent, we) then begin
    case we.EventType of
      WINDOW_ACTIVATE:
        fWindow.Active := true;
      WINDOW_DEACTIVATE:
        fWindow.Active := false;
      WINDOW_RESIZE: begin
        fWindow.ScreenRect   := we.ScreenRect;
        fWindow.ClientWidth  := we.ClientWidth;
        fWindow.ClientHeight := we.ClientHeight;
      end;
    end;
  end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEventManager.CreateMouseEvent(aEvent: TutlMouseEvent; aType: TutlEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint): TutlMouseEvent;
begin
  result := aEvent;
  if not Assigned(result) then
    result := TutlMouseEvent.Create;
  result.EventType := aType;
  result.Button    := aButton;
  result.ClientPos := aClientPos;
  result.ScreenPos := aScreenPos;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEventManager.CreateMouseWheelEvent(aEvent: TutlMouseWheelEvent; aSender: TWinControl; aDelta: Integer; aClientPos: TPoint): TutlMouseWheelEvent;
begin
  result := aEvent;
  if not Assigned(result) then
    result := TutlMouseWheelEvent.Create;
  result.ClientPos  := aClientPos;
  result.ScreenPos  := aSender.ClientToScreen(aClientPos);
  result.WheelDelta := aDelta;
  if (aDelta < 0)
     then result.EventType := MOUSE_WHEEL_DOWN
     else result.EventType := MOUSE_WHEEL_UP;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEventManager.CreateKeyEvent(aEvent: TutlKeyEvent; aType: TutlEventType; aKey: Word): TutlKeyEvent;
begin
  result := aEvent;
  if not Assigned(result) then
    result := TutlKeyEvent.Create;
  if fKeyboard.KeyState[aKey and $FF] and (aType = KEY_DOWN)
     then result.EventType := KEY_REPEAT
     else result.EventType := KEY_DOWN;
  result.KeyCode  := aKey;
  result.CharCode := VKCodeToCharCode(aKey, fKeyboard.Modifiers);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TutlWinControlEventManager.CreateWindowEvent(aEvent: TutlWindowEvent; aType: TutlEventType; aSender: TControl): TutlWindowEvent;
var
  p: TPoint;
begin
  p := aSender.ScreenToClient(Point(0, 0));
  result := aEvent;
  if not Assigned(result) then
    result := TutlWindowEvent.Create;
  result.EventType    := aType;
  result.ClientWidth  := aSender.ClientWidth;
  result.ClientHeight := aSender.ClientHeight;
  result.ScreenRect   := Rect(p.x, p.y, p.x + result.ClientWidth, p.y + result.ClientHeight);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlWinControlEventManager.AttachEvents(const aControl: TWinControl; const aMask: TutlEventTypeMask);
var
  ctl: TWinControlVisibilityClass;
  frm: TCustomFormVisibilityClass;
begin
  ctl := TWinControlVisibilityClass(aControl);

  // mouse events
  if MaskHasType(aMask, MOUSE_DOWN)      then ctl.OnMouseDown  := @HandlerMouseDown;
  if MaskHasType(aMask, MOUSE_UP)        then ctl.OnMouseUp    := @HandlerMouseUp;
  if MaskHasType(aMask, MOUSE_MOVE)      then ctl.OnMouseMove  := @HandlerMouseMove;
  if MaskHasType(aMask, MOUSE_ENTER)     then ctl.OnMouseEnter := @HandlerMouseEnter;
  if MaskHasType(aMask, MOUSE_LEAVE)     then ctl.OnMouseLeave := @HandlerMouseLeave;
  if MaskHasType(aMask, MOUSE_CLICK)     then ctl.OnClick      := @HandlerClick;
  if MaskHasType(aMask, MOUSE_DBL_CLICK) then ctl.OnDblClick   := @HandlerDblClick;
  if MaskHasType(aMask, MOUSE_WHEEL_DOWN) or
     MaskHasType(aMask, MOUSE_WHEEL_UP)  then ctl.OnMouseWheel := @HandlerMouseWheel;

  // key events
  if MaskHasType(aMask, KEY_DOWN) then ctl.OnKeyDown := @HandlerKeyDown;
  if MaskHasType(aMask, KEY_UP)   then ctl.OnKeyUp   := @HandlerKeyUp;

  // window events
  if MaskHasType(aMask, WINDOW_RESIZE) 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 MaskHasType(aMask, WINDOW_ACTIVATE)   then frm.OnActivate   := @HandlerActivate;
    if MaskHasType(aMask, WINDOW_DEACTIVATE) then frm.OnDeactivate := @HandlerDeactivate;
  end;
end;

end.