|
|
|
@@ -13,55 +13,56 @@ uses |
|
|
|
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>; |
|
|
|
TutlEventManager = class(TObject) |
|
|
|
public type |
|
|
|
TEventType = 0..63; |
|
|
|
TEventTypeMask = UInt64; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////// |
|
|
|
TEvent = class |
|
|
|
public |
|
|
|
EventType: TEventType; |
|
|
|
Timestamp: QWord; |
|
|
|
|
|
|
|
function Clone: TEvent; |
|
|
|
procedure Assign(const aEvent: TEvent); virtual; |
|
|
|
constructor Create; virtual; |
|
|
|
end; |
|
|
|
TEventClass = class of TEvent; |
|
|
|
TEventList = specialize TutlList<TEvent>; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
TutlEventHandler = procedure(aSender: TObject; aEvent: TutlEvent) of object; |
|
|
|
TutlCallbackEventListener = class(TutlEventListener) |
|
|
|
public |
|
|
|
Callback: TutlEventHandler; |
|
|
|
Filter: TutlEventTypeMask; |
|
|
|
function DispatchEvent(const aEvent: TutlEvent): Boolean; override; |
|
|
|
end; |
|
|
|
//////////////////////////////////////////////////////////////////////////// |
|
|
|
TEventListener = class(TObject) |
|
|
|
public |
|
|
|
function DispatchEvent(const aEvent: TEvent): Boolean; virtual; |
|
|
|
end; |
|
|
|
TEventListenerSet = specialize TutlHashSet<TEventListener>; |
|
|
|
|
|
|
|
//////////////////////////////////////////////////////////////////////////// |
|
|
|
TEventHandlerCallback = procedure(aSender: TObject; aEvent: TEvent) of object; |
|
|
|
TCallbackEventListener = class(TEventListener) |
|
|
|
public |
|
|
|
Callback: TEventHandlerCallback; |
|
|
|
Filter: TEventTypeMask; |
|
|
|
function DispatchEvent(const aEvent: TEvent): Boolean; override; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
TutlEventManager = class(TObject) |
|
|
|
private |
|
|
|
fEventQueue: TutlEventList; |
|
|
|
fEventQueue: TEventList; |
|
|
|
fEventQueueLock: TCriticalSection; |
|
|
|
fEventListener: TutlEventListenerSet; |
|
|
|
fEventListener: TEventListenerSet; |
|
|
|
|
|
|
|
procedure DispatchEvent(const aEvent: TutlEvent); |
|
|
|
procedure DispatchEvent(const aEvent: TEvent); |
|
|
|
protected |
|
|
|
procedure PushEvent(const aEvent: TutlEvent); virtual; |
|
|
|
procedure RecordEvent(const aEvent: TutlEvent); virtual; |
|
|
|
procedure PushEvent(const aEvent: TEvent); virtual; |
|
|
|
procedure RecordEvent(const aEvent: TEvent); virtual; |
|
|
|
public |
|
|
|
procedure RegisterListener(const aEventMask: TutlEventTypeMask; const aCallback: TutlEventHandler); |
|
|
|
procedure RegisterListener(const aListener: TutlEventListener); |
|
|
|
procedure RegisterListener(const aEventMask: TEventTypeMask; const aCallback: TEventHandlerCallback); |
|
|
|
procedure RegisterListener(const aListener: TEventListener); |
|
|
|
|
|
|
|
procedure UnregisterListener(const aHandler: TutlEventHandler); |
|
|
|
procedure UnregisterListener(const aListener: TutlEventListener); |
|
|
|
procedure UnregisterListener(const aHandler: TEventHandlerCallback); |
|
|
|
procedure UnregisterListener(const aListener: TEventListener); |
|
|
|
|
|
|
|
procedure DispatchEvents; |
|
|
|
|
|
|
|
@@ -69,51 +70,50 @@ type |
|
|
|
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; |
|
|
|
class function MakeMask (const aTypes: array of TEventType): TEventTypeMask; |
|
|
|
class function CombineMasks(const aMasks: array of TEventTypeMask): TEventTypeMask; |
|
|
|
class function MaskHasType (const aMask: TEventTypeMask; const aType: TEventType): Boolean; inline; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
TutlMouseEvent = class(TutlEvent) |
|
|
|
public |
|
|
|
Button: TMouseButton; |
|
|
|
ClientPos: TPoint; |
|
|
|
ScreenPos: TPoint; |
|
|
|
procedure Assign(const aEvent: TutlEvent); override; |
|
|
|
end; |
|
|
|
TutlWinControlEventManager = class(TutlEventManager) |
|
|
|
public type |
|
|
|
//////////////////////////////////////////////////////////////////////////// |
|
|
|
TMouseEvent = class(TEvent) |
|
|
|
public |
|
|
|
Button: TMouseButton; |
|
|
|
ClientPos: TPoint; |
|
|
|
ScreenPos: TPoint; |
|
|
|
procedure Assign(const aEvent: TEvent); override; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
TutlMouseWheelEvent = class(TutlEvent) |
|
|
|
public |
|
|
|
WheelDelta: Integer; |
|
|
|
ClientPos: TPoint; |
|
|
|
ScreenPos: TPoint; |
|
|
|
procedure Assign(const aEvent: TutlEvent); override; |
|
|
|
end; |
|
|
|
//////////////////////////////////////////////////////////////////////////// |
|
|
|
TMouseWheelEvent = class(TEvent) |
|
|
|
public |
|
|
|
WheelDelta: Integer; |
|
|
|
ClientPos: TPoint; |
|
|
|
ScreenPos: TPoint; |
|
|
|
procedure Assign(const aEvent: TEvent); override; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
TutlKeyEvent = class(TutlEvent) |
|
|
|
public |
|
|
|
CharCode: WideChar; |
|
|
|
KeyCode: Word; |
|
|
|
procedure Assign(const aEvent: TutlEvent); override; |
|
|
|
end; |
|
|
|
//////////////////////////////////////////////////////////////////////////// |
|
|
|
TKeyEvent = class(TEvent) |
|
|
|
public |
|
|
|
CharCode: WideChar; |
|
|
|
KeyCode: Word; |
|
|
|
procedure Assign(const aEvent: TEvent); override; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
TutlWindowEvent = class(TutlEvent) |
|
|
|
public |
|
|
|
ScreenRect: TRect; |
|
|
|
ClientWidth: Cardinal; |
|
|
|
ClientHeight: Cardinal; |
|
|
|
procedure Assign(const aEvent: TutlEvent); override; |
|
|
|
end; |
|
|
|
//////////////////////////////////////////////////////////////////////////// |
|
|
|
TWindowEvent = class(TEvent) |
|
|
|
public |
|
|
|
ScreenRect: TRect; |
|
|
|
ClientWidth: Cardinal; |
|
|
|
ClientHeight: Cardinal; |
|
|
|
procedure Assign(const aEvent: TEvent); override; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
TutlWinControlEventManager = class(TutlEventManager) |
|
|
|
public type |
|
|
|
//////////////////////////////////////////////////////////////////////////// |
|
|
|
TMouseButtons = set of TMouseButton; |
|
|
|
TKeyboardState = record |
|
|
|
Modifiers: TShiftState; |
|
|
|
@@ -149,7 +149,7 @@ type |
|
|
|
WINDOW_ACTIVATE = 16; |
|
|
|
WINDOW_DEACTIVATE = 17; |
|
|
|
|
|
|
|
EVENTS_MOUSE: TutlEventTypeMask = |
|
|
|
EVENTS_MOUSE: TEventTypeMask = |
|
|
|
(1 shl MOUSE_DOWN) or |
|
|
|
(1 shl MOUSE_UP) or |
|
|
|
(1 shl MOUSE_WHEEL_UP) or |
|
|
|
@@ -159,11 +159,11 @@ type |
|
|
|
(1 shl MOUSE_LEAVE) or |
|
|
|
(1 shl MOUSE_CLICK) or |
|
|
|
(1 shl MOUSE_DBL_CLICK); |
|
|
|
EVENTS_KEYBOARD: TutlEventTypeMask = |
|
|
|
EVENTS_KEYBOARD: TEventTypeMask = |
|
|
|
(1 shl KEY_DOWN) or |
|
|
|
(1 shl KEY_REPEAT) or |
|
|
|
(1 shl KEY_UP); |
|
|
|
EVENTS_WINDOW: TutlEventTypeMask = |
|
|
|
EVENTS_WINDOW: TEventTypeMask = |
|
|
|
(1 shl WINDOW_RESIZE) or |
|
|
|
(1 shl WINDOW_ACTIVATE) or |
|
|
|
(1 shl WINDOW_DEACTIVATE); |
|
|
|
@@ -190,20 +190,20 @@ type |
|
|
|
procedure HandlerDeactivate (Sender: TObject); |
|
|
|
|
|
|
|
protected |
|
|
|
procedure RecordEvent(const aEvent: TutlEvent); override; |
|
|
|
procedure RecordEvent(const aEvent: TEvent); 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; |
|
|
|
function CreateMouseEvent (aEvent: TMouseEvent; aType: TEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint): TMouseEvent; virtual; |
|
|
|
function CreateMouseWheelEvent(aEvent: TMouseWheelEvent; aSender: TWinControl; aDelta: Integer; aClientPos: TPoint): TMouseWheelEvent; virtual; |
|
|
|
function CreateKeyEvent (aEvent: TKeyEvent; aType: TEventType; aKey: Word): TKeyEvent; virtual; |
|
|
|
function CreateWindowEvent (aEvent: TWindowEvent; aType: TEventType; aSender: TControl): TWindowEvent; 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); |
|
|
|
procedure AttachEvents(const aControl: TWinControl; const aMask: TEventTypeMask); |
|
|
|
end; |
|
|
|
|
|
|
|
implementation |
|
|
|
@@ -232,39 +232,39 @@ type |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlEvent////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlEventManager.TEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlEvent.Clone: TutlEvent; |
|
|
|
function TutlEventManager.TEvent.Clone: TEvent; |
|
|
|
begin |
|
|
|
result := TutlEventClass(ClassType).Create; |
|
|
|
result := TEventClass(ClassType).Create; |
|
|
|
result.Assign(self); |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEvent.Assign(const aEvent: TutlEvent); |
|
|
|
procedure TutlEventManager.TEvent.Assign(const aEvent: TEvent); |
|
|
|
begin |
|
|
|
Timestamp := aEvent.Timestamp; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
constructor TutlEvent.Create; |
|
|
|
constructor TutlEventManager.TEvent.Create; |
|
|
|
begin |
|
|
|
inherited Create; |
|
|
|
Timestamp := GetMicroTime; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlEventListener////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlEventManager.TEventListener//////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlEventListener.DispatchEvent(const aEvent: TutlEvent): Boolean; |
|
|
|
function TutlEventManager.TEventListener.DispatchEvent(const aEvent: TEvent): Boolean; |
|
|
|
begin |
|
|
|
result := false; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlCallbackEventListener/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlEventManager.TCallbackEventListener//////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlCallbackEventListener.DispatchEvent(const aEvent: TutlEvent): Boolean; |
|
|
|
function TutlEventManager.TCallbackEventListener.DispatchEvent(const aEvent: TEvent): Boolean; |
|
|
|
begin |
|
|
|
result := inherited DispatchEvent(aEvent); |
|
|
|
if TutlEventManager.MaskHasType(Filter, aEvent.EventType) then |
|
|
|
@@ -274,9 +274,9 @@ end; |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlEventManager/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEventManager.DispatchEvent(const aEvent: TutlEvent); |
|
|
|
procedure TutlEventManager.DispatchEvent(const aEvent: TEvent); |
|
|
|
var |
|
|
|
l: TutlEventListener; |
|
|
|
l: TEventListener; |
|
|
|
begin |
|
|
|
for l in fEventListener do begin |
|
|
|
if l.DispatchEvent(aEvent) then |
|
|
|
@@ -285,7 +285,7 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEventManager.PushEvent(const aEvent: TutlEvent); |
|
|
|
procedure TutlEventManager.PushEvent(const aEvent: TEvent); |
|
|
|
begin |
|
|
|
fEventQueueLock.Enter; |
|
|
|
try |
|
|
|
@@ -299,18 +299,18 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEventManager.RecordEvent(const aEvent: TutlEvent); |
|
|
|
procedure TutlEventManager.RecordEvent(const aEvent: TEvent); |
|
|
|
begin |
|
|
|
// DUMMY |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEventManager.RegisterListener(const aEventMask: TutlEventTypeMask; const aCallback: TutlEventHandler); |
|
|
|
procedure TutlEventManager.RegisterListener(const aEventMask: TEventTypeMask; const aCallback: TEventHandlerCallback); |
|
|
|
var |
|
|
|
l: TutlCallbackEventListener; |
|
|
|
l: TCallbackEventListener; |
|
|
|
begin |
|
|
|
UnregisterListener(aCallback); |
|
|
|
l := TutlCallbackEventListener.Create; |
|
|
|
l := TCallbackEventListener.Create; |
|
|
|
try |
|
|
|
l.Filter := aEventMask; |
|
|
|
l.Callback := aCallback; |
|
|
|
@@ -321,21 +321,21 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEventManager.RegisterListener(const aListener: TutlEventListener); |
|
|
|
procedure TutlEventManager.RegisterListener(const aListener: TEventListener); |
|
|
|
begin |
|
|
|
fEventListener.Add(aListener); |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEventManager.UnregisterListener(const aHandler: TutlEventHandler); |
|
|
|
procedure TutlEventManager.UnregisterListener(const aHandler: TEventHandlerCallback); |
|
|
|
var |
|
|
|
i: Integer; |
|
|
|
m1, m2: TMethod; |
|
|
|
cel: TutlCallbackEventListener; |
|
|
|
cel: TCallbackEventListener; |
|
|
|
begin |
|
|
|
m1 := TMethod(aHandler); |
|
|
|
for i := fEventListener.Count-1 downto 0 do |
|
|
|
if Supports(fEventListener[i], TutlCallbackEventListener, cel) then begin |
|
|
|
if Supports(fEventListener[i], TCallbackEventListener, cel) then begin |
|
|
|
m2 := TMethod(cel.Callback); |
|
|
|
if (m1.Data = m2.Data) and |
|
|
|
(m1.Code = m2.Code) then |
|
|
|
@@ -344,7 +344,7 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEventManager.UnregisterListener(const aListener: TutlEventListener); |
|
|
|
procedure TutlEventManager.UnregisterListener(const aListener: TEventListener); |
|
|
|
begin |
|
|
|
fEventListener.Remove(aListener); |
|
|
|
end; |
|
|
|
@@ -352,7 +352,7 @@ end; |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlEventManager.DispatchEvents; |
|
|
|
var |
|
|
|
e: TutlEvent; |
|
|
|
e: TEvent; |
|
|
|
begin |
|
|
|
fEventQueueLock.Acquire; |
|
|
|
try |
|
|
|
@@ -372,8 +372,8 @@ end; |
|
|
|
constructor TutlEventManager.Create; |
|
|
|
begin |
|
|
|
inherited Create; |
|
|
|
fEventListener := TutlEventListenerSet.Create(true); |
|
|
|
fEventQueue := TutlEventList.Create(true); |
|
|
|
fEventListener := TEventListenerSet.Create(true); |
|
|
|
fEventQueue := TEventList.Create(true); |
|
|
|
fEventQueueLock := TCriticalSection.Create; |
|
|
|
end; |
|
|
|
|
|
|
|
@@ -392,9 +392,9 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
class function TutlEventManager.MakeMask(const aTypes: array of TutlEventType): TutlEventTypeMask; |
|
|
|
class function TutlEventManager.MakeMask(const aTypes: array of TEventType): TEventTypeMask; |
|
|
|
var |
|
|
|
e: TutlEventType; |
|
|
|
e: TEventType; |
|
|
|
begin |
|
|
|
result := 0; |
|
|
|
for e in aTypes do |
|
|
|
@@ -402,9 +402,9 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
class function TutlEventManager.CombineMasks(const aMasks: array of TutlEventTypeMask): TutlEventTypeMask; |
|
|
|
class function TutlEventManager.CombineMasks(const aMasks: array of TEventTypeMask): TEventTypeMask; |
|
|
|
var |
|
|
|
m: TutlEventTypeMask; |
|
|
|
m: TEventTypeMask; |
|
|
|
begin |
|
|
|
result := 0; |
|
|
|
for m in aMasks do |
|
|
|
@@ -412,20 +412,20 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
class function TutlEventManager.MaskHasType(const aMask: TutlEventTypeMask; const aType: TutlEventType): Boolean; |
|
|
|
class function TutlEventManager.MaskHasType(const aMask: TEventTypeMask; const aType: TEventType): Boolean; |
|
|
|
begin |
|
|
|
result := ((aMask and (1 shl aType)) <> 0); |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlMouseEvent///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlWinControlEventManager.TMouseEvent///////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlMouseEvent.Assign(const aEvent: TutlEvent); |
|
|
|
procedure TutlWinControlEventManager.TMouseEvent.Assign(const aEvent: TEvent); |
|
|
|
var |
|
|
|
me: TutlMouseEvent; |
|
|
|
me: TMouseEvent; |
|
|
|
begin |
|
|
|
inherited Assign(aEvent); |
|
|
|
if Supports(aEvent, TutlMouseEvent, me) then begin |
|
|
|
if Supports(aEvent, TMouseEvent, me) then begin |
|
|
|
Button := me.Button; |
|
|
|
ClientPos := me.ClientPos; |
|
|
|
ScreenPos := me.ScreenPos; |
|
|
|
@@ -433,14 +433,14 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlMouseWheelEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlWinControlEventManager.TMouseWheelEvent//////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlMouseWheelEvent.Assign(const aEvent: TutlEvent); |
|
|
|
procedure TutlWinControlEventManager.TMouseWheelEvent.Assign(const aEvent: TEvent); |
|
|
|
var |
|
|
|
mwe: TutlMouseWheelEvent; |
|
|
|
mwe: TMouseWheelEvent; |
|
|
|
begin |
|
|
|
inherited Assign(aEvent); |
|
|
|
if Supports(aEvent, TutlMouseWheelEvent, mwe) then begin |
|
|
|
if Supports(aEvent, TMouseWheelEvent, mwe) then begin |
|
|
|
WheelDelta := mwe.WheelDelta; |
|
|
|
ClientPos := mwe.ClientPos; |
|
|
|
ScreenPos := mwe.ScreenPos; |
|
|
|
@@ -448,28 +448,28 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlKeyEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlWinControlEventManager.TKeyEvent/////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlKeyEvent.Assign(const aEvent: TutlEvent); |
|
|
|
procedure TutlWinControlEventManager.TKeyEvent.Assign(const aEvent: TEvent); |
|
|
|
var |
|
|
|
ke: TutlKeyEvent; |
|
|
|
ke: TKeyEvent; |
|
|
|
begin |
|
|
|
inherited Assign(aEvent); |
|
|
|
if Supports(aEvent, TutlKeyEvent, ke) then begin |
|
|
|
if Supports(aEvent, TKeyEvent, ke) then begin |
|
|
|
CharCode := ke.CharCode; |
|
|
|
KeyCode := ke.KeyCode; |
|
|
|
end; |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlWindowEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
//TutlWinControlEventManager.TWindowEvent//////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlWindowEvent.Assign(const aEvent: TutlEvent); |
|
|
|
procedure TutlWinControlEventManager.TWindowEvent.Assign(const aEvent: TEvent); |
|
|
|
var |
|
|
|
we: TutlWindowEvent; |
|
|
|
we: TWindowEvent; |
|
|
|
begin |
|
|
|
inherited Assign(aEvent); |
|
|
|
if Supports(aEvent, TutlWindowEvent, we) then begin |
|
|
|
if Supports(aEvent, TWindowEvent, we) then begin |
|
|
|
ScreenRect := we.ScreenRect; |
|
|
|
ClientWidth := we.ClientWidth; |
|
|
|
ClientHeight := we.ClientHeight; |
|
|
|
@@ -558,11 +558,11 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlWinControlEventManager.RecordEvent(const aEvent: TutlEvent); |
|
|
|
procedure TutlWinControlEventManager.RecordEvent(const aEvent: TEvent); |
|
|
|
var |
|
|
|
me: TutlMouseEvent; |
|
|
|
ke: TutlKeyEvent; |
|
|
|
we: TutlWindowEvent; |
|
|
|
me: TMouseEvent; |
|
|
|
ke: TKeyEvent; |
|
|
|
we: TWindowEvent; |
|
|
|
|
|
|
|
function GetPressedButtons: TMouseButtons; |
|
|
|
begin |
|
|
|
@@ -581,7 +581,8 @@ var |
|
|
|
|
|
|
|
begin |
|
|
|
inherited RecordEvent(aEvent); |
|
|
|
if Supports(aEvent, TutlMouseEvent, me) then begin |
|
|
|
|
|
|
|
if Supports(aEvent, TMouseEvent, me) then begin |
|
|
|
fMouse.ClientPos := me.ClientPos; |
|
|
|
fMouse.ScreenPos := me.ScreenPos; |
|
|
|
case me.EventType of |
|
|
|
@@ -594,7 +595,8 @@ begin |
|
|
|
MOUSE_ENTER: |
|
|
|
fMouse.Buttons := GetPressedButtons; |
|
|
|
end; |
|
|
|
end else if Supports(aEvent, TutlKeyEvent, ke) then begin |
|
|
|
|
|
|
|
end else if Supports(aEvent, TKeyEvent, ke) then begin |
|
|
|
case ke.EventType of |
|
|
|
KEY_DOWN, |
|
|
|
KEY_REPEAT: begin |
|
|
|
@@ -617,7 +619,8 @@ begin |
|
|
|
if ([ssCtrl, ssAlt] - fKeyboard.Modifiers = []) |
|
|
|
then include(fKeyboard.Modifiers, ssAltGr) |
|
|
|
else exclude(fKeyboard.Modifiers, ssAltGr); |
|
|
|
end else if Supports(aEvent, TutlWindowEvent, we) then begin |
|
|
|
|
|
|
|
end else if Supports(aEvent, TWindowEvent, we) then begin |
|
|
|
case we.EventType of |
|
|
|
WINDOW_ACTIVATE: |
|
|
|
fWindow.Active := true; |
|
|
|
@@ -633,11 +636,11 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlWinControlEventManager.CreateMouseEvent(aEvent: TutlMouseEvent; aType: TutlEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint): TutlMouseEvent; |
|
|
|
function TutlWinControlEventManager.CreateMouseEvent(aEvent: TMouseEvent; aType: TEventType; aButton: TMouseButton; aClientPos, aScreenPos: TPoint): TMouseEvent; |
|
|
|
begin |
|
|
|
result := aEvent; |
|
|
|
if not Assigned(result) then |
|
|
|
result := TutlMouseEvent.Create; |
|
|
|
result := TMouseEvent.Create; |
|
|
|
result.EventType := aType; |
|
|
|
result.Button := aButton; |
|
|
|
result.ClientPos := aClientPos; |
|
|
|
@@ -645,11 +648,11 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlWinControlEventManager.CreateMouseWheelEvent(aEvent: TutlMouseWheelEvent; aSender: TWinControl; aDelta: Integer; aClientPos: TPoint): TutlMouseWheelEvent; |
|
|
|
function TutlWinControlEventManager.CreateMouseWheelEvent(aEvent: TMouseWheelEvent; aSender: TWinControl; aDelta: Integer; aClientPos: TPoint): TMouseWheelEvent; |
|
|
|
begin |
|
|
|
result := aEvent; |
|
|
|
if not Assigned(result) then |
|
|
|
result := TutlMouseWheelEvent.Create; |
|
|
|
result := TMouseWheelEvent.Create; |
|
|
|
result.ClientPos := aClientPos; |
|
|
|
result.ScreenPos := aSender.ClientToScreen(aClientPos); |
|
|
|
result.WheelDelta := aDelta; |
|
|
|
@@ -659,11 +662,11 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlWinControlEventManager.CreateKeyEvent(aEvent: TutlKeyEvent; aType: TutlEventType; aKey: Word): TutlKeyEvent; |
|
|
|
function TutlWinControlEventManager.CreateKeyEvent(aEvent: TKeyEvent; aType: TEventType; aKey: Word): TKeyEvent; |
|
|
|
begin |
|
|
|
result := aEvent; |
|
|
|
if not Assigned(result) then |
|
|
|
result := TutlKeyEvent.Create; |
|
|
|
result := TKeyEvent.Create; |
|
|
|
if fKeyboard.KeyState[aKey and $FF] and (aType = KEY_DOWN) |
|
|
|
then result.EventType := KEY_REPEAT |
|
|
|
else result.EventType := KEY_DOWN; |
|
|
|
@@ -672,14 +675,14 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
function TutlWinControlEventManager.CreateWindowEvent(aEvent: TutlWindowEvent; aType: TutlEventType; aSender: TControl): TutlWindowEvent; |
|
|
|
function TutlWinControlEventManager.CreateWindowEvent(aEvent: TWindowEvent; aType: TEventType; aSender: TControl): TWindowEvent; |
|
|
|
var |
|
|
|
p: TPoint; |
|
|
|
begin |
|
|
|
p := aSender.ScreenToClient(Point(0, 0)); |
|
|
|
result := aEvent; |
|
|
|
if not Assigned(result) then |
|
|
|
result := TutlWindowEvent.Create; |
|
|
|
result := TWindowEvent.Create; |
|
|
|
result.EventType := aType; |
|
|
|
result.ClientWidth := aSender.ClientWidth; |
|
|
|
result.ClientHeight := aSender.ClientHeight; |
|
|
|
@@ -687,7 +690,7 @@ begin |
|
|
|
end; |
|
|
|
|
|
|
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// |
|
|
|
procedure TutlWinControlEventManager.AttachEvents(const aControl: TWinControl; const aMask: TutlEventTypeMask); |
|
|
|
procedure TutlWinControlEventManager.AttachEvents(const aControl: TWinControl; const aMask: TEventTypeMask); |
|
|
|
var |
|
|
|
ctl: TWinControlVisibilityClass; |
|
|
|
frm: TCustomFormVisibilityClass; |
|
|
|
|