diff --git a/uutlEventManager.pas b/uutlEventManager.pas index a7b45ad..2d8edde 100644 --- a/uutlEventManager.pas +++ b/uutlEventManager.pas @@ -9,202 +9,208 @@ unit uutlEventManager; interface uses - Classes, SysUtils, uutlGenerics, syncobjs, uutlTiming, Controls, Forms, uutlMessageThread, uutlMessages; + Classes, SysUtils, syncobjs, Controls, + uutlGenerics; 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; + TutlEventType = 0..63; + TutlEventTypeMask = UInt64; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEvent = class public - Timestamp: QWord; EventType: TutlEventType; - function Clone: TutlInputEvent; - constructor Create(aType: TutlEventType); + Timestamp: QWord; + + function Clone: TutlEvent; + procedure Assign(const aEvent: TutlEvent); virtual; + constructor Create; virtual; end; - TutlInputEventList = specialize TutlList; + TutlEventClass = class of TutlEvent; + TutlEventList = specialize TutlList; - { TutlMouseEvent } +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlEventListener = class(TObject) + public + function DispatchEvent(const aEvent: TutlEvent): Boolean; virtual; + end; + TutlEventListenerSet = specialize TutlHashSet; - TutlMouseEvent = class(TutlInputEvent) +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + 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 - function CreateInstance: TutlInputEvent; override; - procedure Assign(const aEvent: TutlInputEvent); override; + 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; + end; + +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlMouseEvent = class(TutlEvent) public Button: TMouseButton; - ClientPos, + ClientPos: TPoint; ScreenPos: TPoint; - constructor Create(aType: TutlEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint); - constructor Create(aType: TutlEventType; aClientPos, aScreenPos: TPoint); + procedure Assign(const aEvent: TutlEvent); override; end; - TutlMouseWheelEvent = class(TutlMouseEvent) - protected - function CreateInstance: TutlInputEvent; override; - procedure Assign(const aEvent: TutlInputEvent); override; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlMouseWheelEvent = class(TutlEvent) public WheelDelta: Integer; - constructor Create(aType: TutlEventType; aWheelDelta: Integer; aClientPos, aScreenPos: TPoint); + ClientPos: TPoint; + ScreenPos: TPoint; + procedure Assign(const aEvent: TutlEvent); override; end; - { TutlKeyEvent } - - TutlKeyEvent = class(TutlInputEvent) - protected - function CreateInstance: TutlInputEvent; override; - procedure Assign(const aEvent: TutlInputEvent); override; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlKeyEvent = class(TutlEvent) public CharCode: WideChar; KeyCode: Word; - constructor Create(aType: TutlEventType; aCharCode: WideChar; aKeyCode: Word); + procedure Assign(const aEvent: TutlEvent); override; end; - { TutlWindowEvent } - - TutlWindowEvent = class(TutlInputEvent) - protected - function CreateInstance: TutlInputEvent; override; - procedure Assign(const aEvent: TutlInputEvent); override; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlWindowEvent = class(TutlEvent) public ScreenRect: TRect; - ClientWidth, + ClientWidth: Cardinal; ClientHeight: Cardinal; - constructor Create(aType: TutlEventType; aScreenRect: TRect; aClientWidth, aClientHeight: Cardinal); - constructor Create(aType: TutlEventType; aScreenTopLeft: TPoint; aClientWidth, aClientHeight: Cardinal); + procedure Assign(const aEvent: TutlEvent); override; 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; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TutlWinControlEventManager = class(TutlEventManager) + public type + TMouseButtons = set of TMouseButton; + TKeyboardState = record + Modifiers: TShiftState; + KeyState: array[Byte] of Boolean; end; - - TEventListener = class - ThreadID: TThreadID; - Synchronous: Boolean; - Filter: TutlEventTypes; - Handler: TutlInputEventHandler; - end; - TEventListenerList = specialize TutlList; - - 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; + TMouseState = record + ScreenPos, ClientPos: TPoint; + Buttons: TMouseButtons; 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; + 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 - 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); + fKeyboard: TKeyboardState; + fMouse: TMouseState; + fWindow: TWindowState; - procedure EventHandlerKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState); - procedure EventHandlerKeyUp(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState); + 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); - procedure EventHandlerResize(Sender: TObject); - procedure EventHandlerActivate(Sender: TObject); - procedure EventHandlerDeactivate(Sender: TObject); + protected + procedure RecordEvent(const aEvent: TutlEvent); override; - function QueuePush(const aEvent: TutlInputEvent): TutlInputEvent; + 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; - 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; + property Keyboard: TKeyboardState read fKeyboard; + property Mouse: TMouseState read fMouse; + property Window: TWindowState read fWindow; - constructor Create; - destructor Destroy; override; + procedure AttachEvents(const aControl: TWinControl; const aMask: TutlEventTypeMask); 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; +uses + LCLIntf, Forms, + uutlTiming, uutlConversion, uutlKeyCodes; type TWinControlVisibilityClass = class(TWinControl) @@ -225,337 +231,338 @@ type property OnDeactivate; end; -var - utlEventManager_Singleton: TutlEventManager; - -function utlEventManager: TutlEventManager; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEvent////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEvent.Clone: TutlEvent; begin - if not Assigned(utlEventManager_Singleton) then - utlEventManager_Singleton := TutlEventManager.Create; - result := utlEventManager_Singleton; + result := TutlEventClass(ClassType).Create; + result.Assign(self); end; -{ TSyncInputEventMsg } - -procedure TutlEventManager.TSyncInputEventMsg.ExecuteCallback; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEvent.Assign(const aEvent: TutlEvent); begin - fHandler(fSender, fInputEvent, fDoneEvent); + Timestamp := aEvent.Timestamp; end; -constructor TutlEventManager.TSyncInputEventMsg.Create(const aSender: TObject; - const aHandler: TutlInputEventHandler; const aInputEvent: TutlInputEvent); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEvent.Create; begin inherited Create; - fSender := aSender; - fInputEvent := aInputEvent.Clone; - fHandler := aHandler; - fDoneEvent := false; + Timestamp := GetMicroTime; end; -destructor TutlEventManager.TSyncInputEventMsg.Destroy; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEventListener////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventListener.DispatchEvent(const aEvent: TutlEvent): Boolean; begin - FreeAndNil(fInputEvent); - inherited Destroy; + result := false; end; -{ TInputEventMsg } - -procedure TutlEventManager.TInputEventMsg.ExecuteCallback; -var - done: Boolean; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCallbackEventListener/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCallbackEventListener.DispatchEvent(const aEvent: TutlEvent): Boolean; begin - done := false; - fHandler(fSender, fInputEvent, done); + result := inherited DispatchEvent(aEvent); + if TutlEventManager.MaskHasType(Filter, aEvent.EventType) then + Callback(self, aEvent); end; -constructor TutlEventManager.TInputEventMsg.Create(const aSender: TObject; - const aHandler: TutlInputEventHandler; const aInputEvent: TutlInputEvent); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEventManager/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventManager.DispatchEvent(const aEvent: TutlEvent); +var + l: TutlEventListener; begin - inherited Create; - fSender := aSender; - fInputEvent := aInputEvent.Clone; - fHandler := aHandler; + for l in fEventListener do begin + if l.DispatchEvent(aEvent) then + break; + end; end; -destructor TutlEventManager.TInputEventMsg.Destroy; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventManager.PushEvent(const aEvent: TutlEvent); begin - FreeAndNil(fInputEvent); - inherited Destroy; + fEventQueueLock.Enter; + try + if Assigned(fEventQueue) then + fEventQueue.Add(aEvent) + else if Assigned(aEvent) then + aEvent.Free; + finally + fEventQueueLock.Leave; + end; end; -{ TutlInputEvent } - -function TutlInputEvent.CreateInstance: TutlInputEvent; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventManager.RecordEvent(const aEvent: TutlEvent); begin - result := TutlInputEvent.Create(EventType); + // DUMMY end; -procedure TutlInputEvent.Assign(const aEvent: TutlInputEvent); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventManager.RegisterListener(const aEventMask: TutlEventTypeMask; const aCallback: TutlEventHandler); +var + l: TutlCallbackEventListener; begin - EventType := aEvent.EventType; - Timestamp := aEvent.Timestamp; + UnregisterListener(aCallback); + l := TutlCallbackEventListener.Create; + try + l.Filter := aEventMask; + l.Callback := aCallback; + RegisterListener(l); + except + FreeAndNil(l); + end; end; -function TutlInputEvent.Clone: TutlInputEvent; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventManager.RegisterListener(const aListener: TutlEventListener); begin - result := CreateInstance; - result.Assign(self); + fEventListener.Add(aListener); end; -constructor TutlInputEvent.Create(aType: TutlEventType); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventManager.UnregisterListener(const aHandler: TutlEventHandler); +var + i: Integer; + m1, m2: TMethod; + cel: TutlCallbackEventListener; begin - inherited Create; - Timestamp:= GetMicroTime; - EventType:= aType; + 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; -{ TutlMouseEvent } - -function TutlMouseEvent.CreateInstance: TutlInputEvent; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventManager.UnregisterListener(const aListener: TutlEventListener); begin - result := TutlMouseEvent.Create(EventType, ClientPos, ScreenPos); + fEventListener.Remove(aListener); end; -procedure TutlMouseEvent.Assign(const aEvent: TutlInputEvent); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlEventManager.DispatchEvents; var - e: TutlMouseEvent; + e: TutlEvent; 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; + 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 TutlMouseEvent.Create(aType: TutlEventType; aClientPos, aScreenPos: TPoint); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventManager.Create; begin - inherited Create(aType); - ClientPos:= aClientPos; - ScreenPos:= aScreenPos; + inherited Create; + fEventListener := TutlEventListenerSet.Create(true); + fEventQueue := TutlEventList.Create(true); + fEventQueueLock := TCriticalSection.Create; end; -{ TutlMouseWheelEvent } - -function TutlMouseWheelEvent.CreateInstance: TutlInputEvent; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlEventManager.Destroy; begin - result := TutlMouseWheelEvent.Create(EventType, WheelDelta, ClientPos, ScreenPos); + fEventQueueLock.Enter; + try + FreeAndNil(fEventQueue); + finally + fEventQueueLock.Leave; + end; + FreeAndNil(fEventQueueLock); + FreeAndNil(fEventListener); + inherited Destroy; end; -procedure TutlMouseWheelEvent.Assign(const aEvent: TutlInputEvent); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlEventManager.MakeMask(const aTypes: array of TutlEventType): TutlEventTypeMask; +var + e: TutlEventType; begin - inherited Assign(aEvent); - WheelDelta := (aEvent as TutlMouseWheelEvent).WheelDelta; + result := 0; + for e in aTypes do + result := result or (1 shl e); end; -constructor TutlMouseWheelEvent.Create(aType: TutlEventType; aWheelDelta: Integer; aClientPos, aScreenPos: TPoint); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlEventManager.CombineMasks(const aMasks: array of TutlEventTypeMask): TutlEventTypeMask; +var + m: TutlEventTypeMask; begin - inherited Create(aType, aClientPos, aScreenPos); - WheelDelta := aWheelDelta; + result := 0; + for m in aMasks do + result := result or m; end; -{ TutlKeyEvent } - -function TutlKeyEvent.CreateInstance: TutlInputEvent; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +class function TutlEventManager.MaskHasType(const aMask: TutlEventTypeMask; const aType: TutlEventType): Boolean; begin - result := TutlKeyEvent.Create(EventType, CharCode, KeyCode); + result := ((aMask and (1 shl aType)) <> 0); end; -procedure TutlKeyEvent.Assign(const aEvent: TutlInputEvent); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlMouseEvent///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlMouseEvent.Assign(const aEvent: TutlEvent); var - e: TutlKeyEvent; + me: TutlMouseEvent; 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); + if Supports(aEvent, TutlMouseEvent, me) then begin + Button := me.Button; + ClientPos := me.ClientPos; + ScreenPos := me.ScreenPos; + end; end; -procedure TutlWindowEvent.Assign(const aEvent: TutlInputEvent); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlMouseWheelEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlMouseWheelEvent.Assign(const aEvent: TutlEvent); var - e: TutlWindowEvent; + mwe: TutlMouseWheelEvent; 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; + if Supports(aEvent, TutlMouseWheelEvent, mwe) then begin + WheelDelta := mwe.WheelDelta; + ClientPos := mwe.ClientPos; + ScreenPos := mwe.ScreenPos; + end; end; -constructor TutlWindowEvent.Create(aType: TutlEventType; aScreenTopLeft: TPoint; aClientWidth, aClientHeight: Cardinal); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlKeyEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlKeyEvent.Assign(const aEvent: TutlEvent); +var + ke: TutlKeyEvent; begin - inherited Create(aType); - ClientWidth:= aClientWidth; - ClientHeight:= aClientHeight; - - ScreenRect.TopLeft:= aScreenTopLeft; - ScreenRect.BottomRight:= aScreenTopLeft; - inc(ScreenRect.Right, ClientWidth); - inc(ScreenRect.Bottom, ClientHeight); + inherited Assign(aEvent); + if Supports(aEvent, TutlKeyEvent, ke) then begin + CharCode := ke.CharCode; + KeyCode := ke.KeyCode; + end; end; -{ TutlEventManager } - -{$REGION EventHandler} -procedure TutlEventManager.EventHandlerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlWindowEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWindowEvent.Assign(const aEvent: TutlEvent); +var + we: TutlWindowEvent; begin - QueuePush(TutlMouseEvent.Create(MOUSE_DOWN, Button, Point(X,Y), TWinControl(Sender).ClientToScreen(Point(X,Y)))); + inherited Assign(aEvent); + if Supports(aEvent, TutlWindowEvent, we) then begin + ScreenRect := we.ScreenRect; + ClientWidth := we.ClientWidth; + ClientHeight := we.ClientHeight; + end; end; -procedure TutlEventManager.EventHandlerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlWinControlEventManager///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - QueuePush(TutlMouseEvent.Create(MOUSE_MOVE, Point(X,Y), TWinControl(Sender).ClientToScreen(Point(X,Y)))); + PushEvent(CreateMouseEvent(nil, MOUSE_DOWN, Button, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y)))); end; -procedure TutlEventManager.EventHandlerMouseEnter(Sender: TObject); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin - QueuePush(TutlMouseEvent.Create(MOUSE_ENTER, TWinControl(Sender).ScreenToClient(Mouse.CursorPos), Mouse.CursorPos)); + PushEvent(CreateMouseEvent(nil, MOUSE_UP, Button, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y)))); end; -procedure TutlEventManager.EventHandlerMouseLeave(Sender: TObject); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin - QueuePush(TutlMouseEvent.Create(MOUSE_LEAVE, TWinControl(Sender).ScreenToClient(Mouse.CursorPos), Mouse.CursorPos)); + PushEvent(CreateMouseEvent(nil, MOUSE_MOVE, mbLeft, Point(X, Y), TWinControl(Sender).ClientToScreen(Point(X, Y)))); end; -procedure TutlEventManager.EventHandlerClick(Sender: TObject); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerMouseEnter(Sender: TObject); begin - QueuePush(TutlMouseEvent.Create(MOUSE_CLICK, TWinControl(Sender).ScreenToClient(Mouse.CursorPos), Mouse.CursorPos)); + PushEvent(CreateMouseEvent(nil, MOUSE_ENTER, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos)); end; -procedure TutlEventManager.EventHandlerDblClick(Sender: TObject); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerMouseLeave(Sender: TObject); begin - QueuePush(TutlMouseEvent.Create(MOUSE_DBL_CLICK, TWinControl(Sender).ScreenToClient(Mouse.CursorPos), Mouse.CursorPos)); + PushEvent(CreateMouseEvent(nil, MOUSE_LEAVE, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos)); end; -procedure TutlEventManager.EventHandlerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerClick(Sender: TObject); begin - QueuePush(TutlMouseEvent.Create(MOUSE_UP, Button, Point(X,Y), TWinControl(Sender).ClientToScreen(Point(X,Y)))); + PushEvent(CreateMouseEvent(nil, MOUSE_CLICK, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos)); end; -procedure TutlEventManager.EventHandlerMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerDblClick(Sender: TObject); 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; + PushEvent(CreateMouseEvent(nil, MOUSE_DBL_CLICK, mbLeft, TWinControl(Sender).ScreenToClient(Controls.Mouse.CursorPos), Controls.Mouse.CursorPos)); end; -procedure TutlEventManager.EventHandlerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); -var - ch: WideChar; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); 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)); + PushEvent(CreateMouseWheelEvent(nil, TWinControl(Sender), WheelDelta, MousePos)); + Handled := false; end; -procedure TutlEventManager.EventHandlerKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); -var - ch: WideChar; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin - ch:= VKCodeToCharCode(Key, fCanonicalState.Keyboard.Modifiers); - QueuePush(TutlKeyEvent.Create(KEY_UP, ch, Key)); + PushEvent(CreateKeyEvent(nil, KEY_DOWN, Key)); end; -procedure TutlEventManager.EventHandlerResize(Sender: TObject); -var - w: TControl; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin - w := (Sender as TControl); - QueuePush(TutlWindowEvent.Create(WINDOW_RESIZE, w.ClientToScreen(Point(0,0)), w.ClientWidth, w.ClientHeight)); + PushEvent(CreateKeyEvent(nil, KEY_UP, Key)); end; -procedure TutlEventManager.EventHandlerActivate(Sender: TObject); -var - w: TControl; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerResize(Sender: TObject); begin - w := (Sender as TControl); - QueuePush(TutlWindowEvent.Create(WINDOW_ACTIVATE, w.ClientToScreen(Point(0,0)), w.ClientWidth, w.ClientHeight)); + PushEvent(CreateWindowEvent(nil, WINDOW_RESIZE, TControl(Sender))); end; -procedure TutlEventManager.EventHandlerDeactivate(Sender: TObject); -var - w: TControl; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerActivate(Sender: TObject); begin - w := (Sender as TControl); - QueuePush(TutlWindowEvent.Create(WINDOW_DEACTIVATE, w.ClientToScreen(Point(0,0)), w.ClientWidth, w.ClientHeight)); + PushEvent(CreateWindowEvent(nil, WINDOW_ACTIVATE, TControl(Sender))); end; -{$ENDREGION} -function TutlEventManager.QueuePush(const aEvent: TutlInputEvent): TutlInputEvent; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.HandlerDeactivate(Sender: TObject); begin - fEventQueueLock.Acquire; - try - if Assigned(fEventQueue) then - fEventQueue.Add(aEvent); - Result:= aEvent; - finally - fEventQueueLock.Release; - end; + PushEvent(CreateWindowEvent(nil, WINDOW_DEACTIVATE, TControl(Sender))); end; -function TutlEventManager.DispatchEvent(const aEvent: TutlInputEvent): boolean; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.RecordEvent(const aEvent: TutlEvent); 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); + me: TutlMouseEvent; + ke: TutlKeyEvent; + we: TutlWindowEvent; function GetPressedButtons: TMouseButtons; begin @@ -573,179 +580,148 @@ procedure TutlEventManager.RecordEvent(const aEvent: TutlInputEvent); 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; + 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; - 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; + 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 -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; + 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; - //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; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlWinControlEventManager.CreateMouseEvent(aEvent: TutlMouseEvent; aType: TutlEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint): TutlMouseEvent; 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; + result := aEvent; + if not Assigned(result) then + result := TutlMouseEvent.Create; + result.EventType := aType; + result.Button := aButton; + result.ClientPos := aClientPos; + result.ScreenPos := aScreenPos; end; -function TutlEventManager.IsKeyDown(const aChar: Char): Boolean; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlWinControlEventManager.CreateMouseWheelEvent(aEvent: TutlMouseWheelEvent; aSender: TWinControl; aDelta: Integer; aClientPos: TPoint): TutlMouseWheelEvent; begin - result := CanonicalState.Keyboard.KeyState[Ord(UpCase(aChar))]; + 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; -procedure TutlEventManager.RegisterListener(const aEventMask: TutlEventTypes; - const aHandler: TutlInputEventHandler; const aSynchronous: Boolean); -var - ls: TEventListener; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlWinControlEventManager.CreateKeyEvent(aEvent: TutlKeyEvent; aType: TutlEventType; aKey: Word): TutlKeyEvent; 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; + 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; -procedure TutlEventManager.UnregisterListener(const aHandler: TutlInputEventHandler); +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlWinControlEventManager.CreateWindowEvent(aEvent: TutlWindowEvent; aType: TutlEventType; aSender: TControl): TutlWindowEvent; var - i: integer; - m1, m2: TMethod; + p: TPoint; 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; + 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; -constructor TutlEventManager.Create; +///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlWinControlEventManager.AttachEvents(const aControl: TWinControl; const aMask: TutlEventTypeMask); +var + ctl: TWinControlVisibilityClass; + frm: TCustomFormVisibilityClass; begin - inherited Create; - fEventQueue:= TutlInputEventList.Create(true); - fEventQueueLock:= TCriticalSection.Create; - fListeners:= TEventListenerList.Create(true); -end; + ctl := TWinControlVisibilityClass(aControl); -destructor TutlEventManager.Destroy; -begin - FreeAndNil(fListeners); - fEventQueueLock.Acquire; - try - fEventQueue.Clear; - FreeAndNil(fEventQueue); - finally - fEventQueueLock.Release; + // 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; - FreeAndNil(fEventQueueLock); - inherited Destroy; end; -finalization - if Assigned(utlEventManager_Singleton) then - FreeAndNil(utlEventManager_Singleton); - end. diff --git a/uutlLogger.pas b/uutlLogger.pas index b80cd4d..55047f5 100644 --- a/uutlLogger.pas +++ b/uutlLogger.pas @@ -84,16 +84,21 @@ type TutlFileLogger = class(TutlInterfaceNoRefCount, IutlLogConsumer) private fStream: TFileStream; - fAutoFlush: boolean; + fAutoFlush: Boolean; + fAutoFree: Boolean; + procedure SetAutoFree(aValue: Boolean); + protected + function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; override; protected procedure WriteLog(const aLogger: TutlLogger; const aTime: TDateTime; const aLevel: TutlLogLevel; const aSender: string; const aMessage: String); public - constructor Create(const aFilename: String; const aMode: TutlFileLoggerMode); + constructor Create(const aFilename: String; const aMode: TutlFileLoggerMode; const aAutoFree: Boolean = false); destructor Destroy; override; procedure Flush(); overload; published - property AutoFlush:boolean read fAutoFlush write fAutoFlush; + property AutoFlush: Boolean read fAutoFlush write fAutoFlush; + property AutoFree: Boolean read fAutoFree write SetAutoFree; end; { TutlConsoleLogger } @@ -172,6 +177,22 @@ begin {$ENDIF} end; +procedure TutlFileLogger.SetAutoFree(aValue: Boolean); +begin + if fAutoFree = aValue then + Exit; + fAutoFree := aValue; + if (fRefCount <= 0) and fAutoFree then + Free; +end; + +function TutlFileLogger._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; +begin + result := inherited _Release; + if (Result <= 0) and fAutoFree then + Free; +end; + procedure TutlFileLogger.WriteLog(const aLogger: TutlLogger; const aTime: TDateTime; const aLevel: TutlLogLevel; const aSender: string; const aMessage: String); var @@ -185,7 +206,7 @@ begin end; end; -constructor TutlFileLogger.Create(const aFilename: String; const aMode: TutlFileLoggerMode); +constructor TutlFileLogger.Create(const aFilename: String; const aMode: TutlFileLoggerMode; const aAutoFree: Boolean = false); const RIGHTS: Cardinal = {$IFNDEF UNIX}fmShareDenyWrite{$ELSE}%0100100100 {-r--r--r--}{$ENDIF}; begin @@ -204,7 +225,8 @@ begin end else raise; end; - AutoFlush:=true; + AutoFlush := true; + fAutoFree := aAutoFree; end; destructor TutlFileLogger.Destroy; @@ -272,13 +294,16 @@ end; procedure TutlLogger.RegisterConsumer(const aConsumer: IutlLogConsumer; const aFilter: TutlLogLevels); var ll: TutlLogLevel; + tmp: IutlLogConsumer; begin fConsumersLock.Acquire; try + tmp := aConsumer; // HACK: store interface due to ref count bug :/ for ll:= low(ll) to high(ll) do - if (ll in aFilter) and (fConsumers[ll].IndexOf(aConsumer)<0) then - fConsumers[ll].Add(aConsumer); + if (ll in aFilter) and (fConsumers[ll].IndexOf(tmp) < 0) then + fConsumers[ll].Add(tmp); finally + tmp := nil; fConsumersLock.Release; end; if llDebug in aFilter then @@ -291,7 +316,7 @@ var begin fConsumersLock.Acquire; try - for ll:= low(ll) to high(ll) do + for ll := low(ll) to high(ll) do if ll in aFilter then fConsumers[ll].Remove(aConsumer); finally