You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

639 lines
25 KiB

  1. unit uutlEventManager;
  2. { Package: Utils
  3. Prefix: utl - UTiLs
  4. Beschreibung: diese Unit verwaltet Events und verteilt diese an registrierte Programm-Teile }
  5. {$mode objfpc}{$H+}
  6. interface
  7. uses
  8. Classes, SysUtils, Controls,
  9. uutlEvent, uutlCommon;
  10. type
  11. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  12. TutlEventType = byte;
  13. TutlEventTypes = set of TutlEventType;
  14. TutlMouseButtons = set of TMouseButton;
  15. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  16. TutlWinControlEventArgs = class(TutlEventArgs)
  17. private
  18. fControl: TControl;
  19. fEventType: TutlEventType;
  20. fTimestamp: Single;
  21. public
  22. property Control: TControl read fControl;
  23. property EventType: TutlEventType read fEventType;
  24. property Timestamp: Single read fTimestamp;
  25. constructor Create(
  26. const aControl: TControl;
  27. const aEventType: TutlEventType);
  28. end;
  29. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  30. TutlMouseEventArgs = class(TutlWinControlEventArgs)
  31. private
  32. fButtons: TutlMouseButtons;
  33. fClientPos: TPoint;
  34. fScreenPos: TPoint;
  35. public
  36. property Buttons: TutlMouseButtons read fButtons;
  37. property ClientPos: TPoint read fClientPos;
  38. property ScreenPos: TPoint read fScreenPos;
  39. constructor Create(
  40. const aControl: TControl;
  41. const aEventType: TutlEventType;
  42. const aButtons: TutlMouseButtons;
  43. const aClientPos: TPoint);
  44. end;
  45. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  46. TutlMouseWheelEventArgs = class(TutlWinControlEventArgs)
  47. private
  48. fWheelDelta: Integer;
  49. fClientPos: TPoint;
  50. fScreenPos: TPoint;
  51. public
  52. property WheelDelta: Integer read fWheelDelta;
  53. property ClientPos: TPoint read fClientPos;
  54. property ScreenPos: TPoint read fScreenPos;
  55. constructor Create(
  56. const aControl: TControl;
  57. const aWheelDelta: Integer;
  58. const aClientPos: TPoint);
  59. end;
  60. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  61. TutlKeyEventArgs = class(TutlWinControlEventArgs)
  62. private
  63. fCharCode: WideChar;
  64. fKeyCode: Word;
  65. public
  66. property CharCode: WideChar read fCharCode;
  67. property KeyCode: Word read fKeyCode;
  68. constructor Create(
  69. const aControl: TControl;
  70. const aEventType: TutlEventType;
  71. const aCharCode: WideChar;
  72. const aKeyCode: Word);
  73. end;
  74. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  75. TutlWindowEventArgs = class(TutlWinControlEventArgs)
  76. private
  77. fScreenRect: TRect;
  78. fClientWidth: Cardinal;
  79. fClientHeight: Cardinal;
  80. public
  81. property ScreenRect: TRect read fScreenRect;
  82. property ClientWidth: Cardinal read fClientWidth;
  83. property ClientHeight: Cardinal read fClientHeight;
  84. constructor Create(
  85. const aControl: TControl;
  86. const aEventType: TutlEventType;
  87. const aScreenRect: TRect;
  88. const aClientWidth: Cardinal;
  89. const aClientHeight: Cardinal);
  90. end;
  91. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  92. TutlWinControlEventManager = class(
  93. TutlInterfacedObject
  94. , IutlObservable)
  95. public const
  96. EVENT_MOUSE_DOWN = 0;
  97. EVENT_MOUSE_UP = 1;
  98. EVENT_MOUSE_WHEEL_UP = 2;
  99. EVENT_MOUSE_WHEEL_DOWN = 3;
  100. EVENT_MOUSE_MOVE = 4;
  101. EVENT_MOUSE_ENTER = 5;
  102. EVENT_MOUSE_LEAVE = 6;
  103. EVENT_MOUSE_CLICK = 7;
  104. EVENT_MOUSE_DBL_CLICK = 8;
  105. EVENT_KEY_DOWN = 10;
  106. EVENT_KEY_REPEAT = 11;
  107. EVENT_KEY_UP = 12;
  108. EVENT_WINDOW_RESIZE = 15;
  109. EVENT_WINDOW_ACTIVATE = 16;
  110. EVENT_WINDOW_DEACTIVATE = 17;
  111. EVENTS_MOUSE: TutlEventTypes = [
  112. EVENT_MOUSE_DOWN,
  113. EVENT_MOUSE_UP,
  114. EVENT_MOUSE_WHEEL_UP,
  115. EVENT_MOUSE_WHEEL_DOWN,
  116. EVENT_MOUSE_MOVE,
  117. EVENT_MOUSE_ENTER,
  118. EVENT_MOUSE_LEAVE,
  119. EVENT_MOUSE_CLICK,
  120. EVENT_MOUSE_DBL_CLICK
  121. ];
  122. EVENTS_KEYBOARD: TutlEventTypes = [
  123. EVENT_KEY_DOWN,
  124. EVENT_KEY_REPEAT,
  125. EVENT_KEY_UP
  126. ];
  127. EVENTS_WINDOW: TutlEventTypes = [
  128. EVENT_WINDOW_RESIZE,
  129. EVENT_WINDOW_ACTIVATE,
  130. EVENT_WINDOW_DEACTIVATE
  131. ];
  132. public type
  133. TutlEventType = uutlEventManager.TutlEventType;
  134. TutlEventTypes = uutlEventManager.TutlEventTypes;
  135. TutlMouseButtons = uutlEventManager.TutlMouseButtons;
  136. TutlWinControlEventArgs = uutlEventManager.TutlWinControlEventArgs;
  137. TutlMouseEventArgs = uutlEventManager.TutlMouseEventArgs;
  138. TutlMouseWheelEventArgs = uutlEventManager.TutlMouseWheelEventArgs;
  139. TutlKeyEventArgs = uutlEventManager.TutlKeyEventArgs;
  140. TutlWindowEventArgs = uutlEventManager.TutlWindowEventArgs;
  141. private type
  142. TKeyboardState = record
  143. Modifiers: TShiftState;
  144. KeyState: array[Byte] of Boolean;
  145. end;
  146. TMouseState = record
  147. ScreenPos: TPoint;
  148. ClientPos: TPoint;
  149. Buttons: TutlMouseButtons;
  150. end;
  151. TWindowState = record
  152. Active: Boolean;
  153. ScreenRect: TRect;
  154. ClientWidth: Integer;
  155. ClientHeight: Integer;
  156. end;
  157. private
  158. fKeyboard: TKeyboardState;
  159. fMouse: TMouseState;
  160. fWindow: TWindowState;
  161. fEventListener: TutlEventListenerSet;
  162. procedure HandlerMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  163. procedure HandlerMouseUp (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  164. procedure HandlerMouseMove (Sender: TObject; Shift: TShiftState; X, Y: Integer);
  165. procedure HandlerMouseEnter (Sender: TObject);
  166. procedure HandlerMouseLeave (Sender: TObject);
  167. procedure HandlerClick (Sender: TObject);
  168. procedure HandlerDblClick (Sender: TObject);
  169. procedure HandlerMouseWheel (Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  170. procedure HandlerKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
  171. procedure HandlerKeyUp (Sender: TObject; var Key: Word; Shift: TShiftState);
  172. procedure HandlerResize (Sender: TObject);
  173. procedure HandlerActivate (Sender: TObject);
  174. procedure HandlerDeactivate (Sender: TObject);
  175. protected
  176. procedure RecordEvent(aEventArgs: IutlEventArgs); virtual;
  177. procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
  178. function CreateMouseEventArgs(
  179. aControl: TControl;
  180. aType: TutlEventType;
  181. aButtons: TutlMouseButtons;
  182. aClientPos: TPoint): IutlEventArgs; virtual;
  183. function CreateMouseWheelEventArgs(
  184. aControl: TControl;
  185. aDelta: Integer;
  186. aClientPos: TPoint): IutlEventArgs; virtual;
  187. function CreateKeyEventArgs(
  188. aControl: TControl;
  189. aType: TutlEventType;
  190. aKey: Word): IutlEventArgs; virtual;
  191. function CreateWindowEventArgs(
  192. aControl: TControl;
  193. aType: TutlEventType): IutlEventArgs; virtual;
  194. public { IutlObservable }
  195. procedure RegisterEventListener (aListener: IutlEventListener);
  196. procedure UnregisterEventListener(aListener: IutlEventListener);
  197. public
  198. property Keyboard: TKeyboardState read fKeyboard;
  199. property Mouse: TMouseState read fMouse;
  200. property Window: TWindowState read fWindow;
  201. procedure AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes);
  202. constructor Create;
  203. destructor Destroy; override;
  204. end;
  205. implementation
  206. uses
  207. LCLIntf, Forms,
  208. uutlKeyCodes;
  209. type
  210. TWinControlVisibilityClass = class(TWinControl)
  211. published
  212. property OnMouseDown;
  213. property OnMouseMove;
  214. property OnMouseUp;
  215. property OnMouseWheel;
  216. property OnMouseEnter;
  217. property OnMouseLeave;
  218. property OnClick;
  219. property OnDblClick;
  220. end;
  221. TCustomFormVisibilityClass = class(TCustomForm)
  222. published
  223. property OnActivate;
  224. property OnDeactivate;
  225. end;
  226. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  227. //TutlWinControlEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  228. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  229. constructor TutlWinControlEventArgs.Create(const aControl: TControl; const aEventType: TutlEventType);
  230. begin
  231. inherited Create;
  232. fControl := aControl;
  233. fEventType := aEventType;
  234. fTimestamp := GetMicroTime / 1000000;
  235. end;
  236. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  237. //TutlMouseEventArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  238. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  239. constructor TutlMouseEventArgs.Create(
  240. const aControl: TControl;
  241. const aEventType: TutlEventType;
  242. const aButtons: TutlMouseButtons;
  243. const aClientPos: TPoint);
  244. begin
  245. inherited Create(aControl, aEventType);
  246. fButtons := aButtons;
  247. fClientPos := aClientPos;
  248. fScreenPos := Control.ClientToScreen(fClientPos);
  249. end;
  250. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  251. //TutlMouseWheelEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  252. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  253. constructor TutlMouseWheelEventArgs.Create(
  254. const aControl: TControl;
  255. const aWheelDelta: Integer;
  256. const aClientPos: TPoint);
  257. begin
  258. if (aWheelDelta < 0)
  259. then inherited Create(aControl, TutlWinControlEventManager.EVENT_MOUSE_WHEEL_DOWN)
  260. else inherited Create(aControl, TutlWinControlEventManager.EVENT_MOUSE_WHEEL_UP);
  261. fWheelDelta := aWheelDelta;
  262. fClientPos := aClientPos;
  263. fScreenPos := Control.ClientToScreen(fClientPos);
  264. end;
  265. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  266. //TutlKeyEventArgs///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  267. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  268. constructor TutlKeyEventArgs.Create(
  269. const aControl: TControl;
  270. const aEventType: TutlEventType;
  271. const aCharCode: WideChar;
  272. const aKeyCode: Word);
  273. begin
  274. inherited Create(aControl, aEventType);
  275. fCharCode := aCharCode;
  276. fKeyCode := aKeyCode;
  277. end;
  278. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  279. //TutlWindowEventArgs////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  280. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  281. constructor TutlWindowEventArgs.Create(
  282. const aControl: TControl;
  283. const aEventType: TutlEventType;
  284. const aScreenRect: TRect;
  285. const aClientWidth: Cardinal;
  286. const aClientHeight: Cardinal);
  287. begin
  288. inherited Create(aControl, aEventType);
  289. fScreenRect := aScreenRect;
  290. fClientWidth := aClientWidth;
  291. fClientHeight := aClientHeight;
  292. end;
  293. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  294. //TutlWinControlEventManager/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  295. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  296. procedure TutlWinControlEventManager.HandlerMouseDown(Sender: TObject; Button: TMouseButton;
  297. Shift: TShiftState; X, Y: Integer);
  298. begin
  299. DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_DOWN, [Button], Point(X, Y)));
  300. end;
  301. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  302. procedure TutlWinControlEventManager.HandlerMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  303. begin
  304. DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_UP, [Button], Point(X, Y)));
  305. end;
  306. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  307. procedure TutlWinControlEventManager.HandlerMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  308. begin
  309. DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_MOVE, [], Point(X, Y)));
  310. end;
  311. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  312. procedure TutlWinControlEventManager.HandlerMouseEnter(Sender: TObject);
  313. begin
  314. DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_ENTER, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
  315. end;
  316. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  317. procedure TutlWinControlEventManager.HandlerMouseLeave(Sender: TObject);
  318. begin
  319. DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_LEAVE, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
  320. end;
  321. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  322. procedure TutlWinControlEventManager.HandlerClick(Sender: TObject);
  323. begin
  324. DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
  325. end;
  326. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  327. procedure TutlWinControlEventManager.HandlerDblClick(Sender: TObject);
  328. begin
  329. DispatchEvent(self, CreateMouseEventArgs(Sender as TControl, EVENT_MOUSE_DBL_CLICK, [], TControl(Sender).ScreenToClient(Controls.Mouse.CursorPos)));
  330. end;
  331. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  332. procedure TutlWinControlEventManager.HandlerMouseWheel(Sender: TObject; Shift: TShiftState;
  333. WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  334. begin
  335. DispatchEvent(self, CreateMouseWheelEventArgs(Sender as TControl, WheelDelta, MousePos));
  336. Handled := false;
  337. end;
  338. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  339. procedure TutlWinControlEventManager.HandlerKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  340. begin
  341. DispatchEvent(self, CreateKeyEventArgs(Sender as TControl, EVENT_KEY_DOWN, Key));
  342. end;
  343. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  344. procedure TutlWinControlEventManager.HandlerKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  345. begin
  346. DispatchEvent(self, CreateKeyEventArgs(Sender as TControl, EVENT_KEY_UP, Key));
  347. end;
  348. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  349. procedure TutlWinControlEventManager.HandlerResize(Sender: TObject);
  350. begin
  351. DispatchEvent(self, CreateWindowEventArgs(Sender as TControl, EVENT_WINDOW_RESIZE));
  352. end;
  353. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  354. procedure TutlWinControlEventManager.HandlerActivate(Sender: TObject);
  355. begin
  356. DispatchEvent(self, CreateWindowEventArgs(Sender as TControl, EVENT_WINDOW_ACTIVATE));
  357. end;
  358. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  359. procedure TutlWinControlEventManager.HandlerDeactivate(Sender: TObject);
  360. begin
  361. DispatchEvent(self, CreateWindowEventArgs(Sender as TControl, EVENT_WINDOW_DEACTIVATE));
  362. end;
  363. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  364. procedure TutlWinControlEventManager.RecordEvent(aEventArgs: IutlEventArgs);
  365. var
  366. mea: TutlMouseEventArgs;
  367. kea: TutlKeyEventArgs;
  368. wea: TutlWindowEventArgs;
  369. function GetPressedButtons: TutlMouseButtons;
  370. begin
  371. result := [];
  372. if (GetKeyState(VK_LBUTTON) < 0) then
  373. result := result + [mbLeft];
  374. if (GetKeyState(VK_RBUTTON) < 0) then
  375. result := result + [mbRight];
  376. if (GetKeyState(VK_MBUTTON) < 0) then
  377. result := result + [mbMiddle];
  378. if (GetKeyState(VK_XBUTTON1) < 0) then
  379. result := result + [mbExtra1];
  380. if (GetKeyState(VK_XBUTTON2) < 0) then
  381. result := result + [mbExtra2];
  382. end;
  383. begin
  384. if Supports(aEventArgs, TutlMouseEventArgs, mea) then begin
  385. fMouse.ClientPos := mea.ClientPos;
  386. fMouse.ScreenPos := mea.ScreenPos;
  387. case mea.EventType of
  388. EVENT_MOUSE_DOWN:
  389. fMouse.Buttons := fMouse.Buttons + mea.Buttons;
  390. EVENT_MOUSE_UP:
  391. fMouse.Buttons := fMouse.Buttons - mea.Buttons;
  392. EVENT_MOUSE_LEAVE:
  393. fMouse.Buttons := [];
  394. EVENT_MOUSE_ENTER:
  395. fMouse.Buttons := GetPressedButtons;
  396. end;
  397. end else if Supports(aEventArgs, TutlKeyEventArgs, kea) then begin
  398. case kea.EventType of
  399. EVENT_KEY_DOWN,
  400. EVENT_KEY_REPEAT: begin
  401. fKeyboard.KeyState[kea.KeyCode and $FF] := true;
  402. case kea.KeyCode of
  403. VK_SHIFT: Include(fKeyboard.Modifiers, ssShift);
  404. VK_MENU: Include(fKeyboard.Modifiers, ssAlt);
  405. VK_CONTROL: Include(fKeyboard.Modifiers, ssCtrl);
  406. end;
  407. end;
  408. EVENT_KEY_UP: begin
  409. fKeyboard.KeyState[kea.KeyCode and $FF] := false;
  410. case kea.KeyCode of
  411. VK_SHIFT: Exclude(fKeyboard.Modifiers, ssShift);
  412. VK_MENU: Exclude(fKeyboard.Modifiers, ssAlt);
  413. VK_CONTROL: Exclude(fKeyboard.Modifiers, ssCtrl);
  414. end;
  415. end;
  416. end;
  417. if ([ssCtrl, ssAlt] - fKeyboard.Modifiers = [])
  418. then include(fKeyboard.Modifiers, ssAltGr)
  419. else exclude(fKeyboard.Modifiers, ssAltGr);
  420. end else if Supports(aEventArgs, TutlWindowEventArgs, wea) then begin
  421. case wea.EventType of
  422. EVENT_WINDOW_ACTIVATE:
  423. fWindow.Active := true;
  424. EVENT_WINDOW_DEACTIVATE:
  425. fWindow.Active := false;
  426. EVENT_WINDOW_RESIZE: begin
  427. fWindow.ScreenRect := wea.ScreenRect;
  428. fWindow.ClientWidth := wea.ClientWidth;
  429. fWindow.ClientHeight := wea.ClientHeight;
  430. end;
  431. end;
  432. end;
  433. end;
  434. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  435. procedure TutlWinControlEventManager.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
  436. begin
  437. RecordEvent(aEventArgs);
  438. fEventListener.DispatchEvent(aSender, aEventArgs);
  439. end;
  440. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  441. function TutlWinControlEventManager.CreateMouseEventArgs(
  442. aControl: TControl;
  443. aType: TutlEventType;
  444. aButtons: TutlMouseButtons;
  445. aClientPos: TPoint): IutlEventArgs;
  446. begin
  447. result := TutlMouseEventArgs.Create(
  448. aControl,
  449. aType,
  450. aButtons,
  451. aClientPos);
  452. end;
  453. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  454. function TutlWinControlEventManager.CreateMouseWheelEventArgs(
  455. aControl: TControl;
  456. aDelta: Integer;
  457. aClientPos: TPoint): IutlEventArgs;
  458. begin
  459. result := TutlMouseWheelEventArgs.Create(
  460. aControl,
  461. aDelta,
  462. aClientPos);
  463. end;
  464. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  465. function TutlWinControlEventManager.CreateKeyEventArgs(
  466. aControl: TControl;
  467. aType: TutlEventType;
  468. aKey: Word): IutlEventArgs;
  469. begin
  470. if (aType = EVENT_KEY_DOWN) and fKeyboard.KeyState[aKey and $FF] then
  471. aType := EVENT_KEY_REPEAT;
  472. result := TutlKeyEventArgs.Create(
  473. aControl,
  474. aType,
  475. VKCodeToCharCode(aKey, fKeyboard.Modifiers),
  476. aKey);
  477. end;
  478. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  479. function TutlWinControlEventManager.CreateWindowEventArgs(
  480. aControl: TControl;
  481. aType: TutlEventType): IutlEventArgs;
  482. var
  483. p0, p1: TPoint;
  484. begin
  485. with aControl do begin
  486. p0 := ClientToScreen(Point(0, 0));
  487. p1 := ClientToScreen(Point(Width, Height));
  488. end;
  489. result := TutlWindowEventArgs.Create(
  490. aControl,
  491. aType,
  492. Rect(p0.x, p0.y, p1.x, p1.y),
  493. (aControl as TWinControl).ClientWidth,
  494. (aControl as TWinControl).ClientHeight);
  495. end;
  496. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  497. procedure TutlWinControlEventManager.RegisterEventListener(aListener: IutlEventListener);
  498. begin
  499. if Assigned(fEventListener) then
  500. fEventListener.Add(aListener);
  501. end;
  502. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  503. procedure TutlWinControlEventManager.UnregisterEventListener(aListener: IutlEventListener);
  504. begin
  505. if Assigned(fEventListener) then
  506. fEventListener.Remove(aListener);
  507. end;
  508. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  509. procedure TutlWinControlEventManager.AttachEvents(const aControl: TWinControl; const aTypes: TutlEventTypes);
  510. var
  511. ctl: TWinControlVisibilityClass;
  512. frm: TCustomFormVisibilityClass;
  513. begin
  514. ctl := TWinControlVisibilityClass(aControl);
  515. // mouse events
  516. if (EVENT_MOUSE_DOWN in aTypes) then ctl.OnMouseDown := @HandlerMouseDown;
  517. if (EVENT_MOUSE_UP in aTypes) then ctl.OnMouseUp := @HandlerMouseUp;
  518. if (EVENT_MOUSE_MOVE in aTypes) then ctl.OnMouseMove := @HandlerMouseMove;
  519. if (EVENT_MOUSE_ENTER in aTypes) then ctl.OnMouseEnter := @HandlerMouseEnter;
  520. if (EVENT_MOUSE_LEAVE in aTypes) then ctl.OnMouseLeave := @HandlerMouseLeave;
  521. if (EVENT_MOUSE_CLICK in aTypes) then ctl.OnClick := @HandlerClick;
  522. if (EVENT_MOUSE_DBL_CLICK in aTypes) then ctl.OnDblClick := @HandlerDblClick;
  523. if (EVENT_MOUSE_WHEEL_DOWN in aTypes) or
  524. (EVENT_MOUSE_WHEEL_UP in aTypes) then ctl.OnMouseWheel := @HandlerMouseWheel;
  525. // key events
  526. if (EVENT_KEY_DOWN in aTypes) then ctl.OnKeyDown := @HandlerKeyDown;
  527. if (EVENT_KEY_UP in aTypes) then ctl.OnKeyUp := @HandlerKeyUp;
  528. // window events
  529. if (EVENT_WINDOW_RESIZE in aTypes) then begin
  530. ctl.OnResize := @HandlerResize;
  531. fWindow.ClientWidth := ctl.ClientWidth;
  532. fWindow.ClientHeight := ctl.ClientHeight;
  533. end;
  534. if (aControl is TCustomForm) then begin
  535. frm := TCustomFormVisibilityClass(aControl);
  536. frm.KeyPreview := true;
  537. if (EVENT_WINDOW_ACTIVATE in aTypes) then frm.OnActivate := @HandlerActivate;
  538. if (EVENT_WINDOW_DEACTIVATE in aTypes) then frm.OnDeactivate := @HandlerDeactivate;
  539. end;
  540. end;
  541. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  542. constructor TutlWinControlEventManager.Create;
  543. begin
  544. inherited Create;
  545. fEventListener := TutlEventListenerSet.Create;
  546. end;
  547. /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  548. destructor TutlWinControlEventManager.Destroy;
  549. begin
  550. FreeAndNil(fEventListener);
  551. inherited Destroy;
  552. end;
  553. end.