[Lazarus] Is event OnMessage useful
Michael W. Vogel
m-w-vogel at gmx.de
Fri Jan 8 13:17:15 CET 2016
Hi,
Sometimes I have to react on some messages of a component where is no
(published) eventhandler for. Mostly I create a package with components
for each project, where I react in the overriden WndProc.
What is your opinion about a event OnMessage where you can react on
(unhandled) messages?
I add a patch to show you how I mean it. I also add a minimal example
for what it is useful for (two grids showing the same row, it works by
scrolling by mouse and scrollbar and selecting a cell, tested on Windows 7).
Thank you
Michael
-------------- next part --------------
Index: lcl/controls.pp
===================================================================
--- lcl/controls.pp (revision 51225)
+++ lcl/controls.pp (working copy)
@@ -387,6 +387,7 @@
TDragDropEvent = procedure(Sender, Source: TObject; X,Y: Integer) of object;
TStartDragEvent = procedure(Sender: TObject; var DragObject: TDragObject) of object;
TEndDragEvent = procedure(Sender, Target: TObject; X,Y: Integer) of object;
+ TMessageEvent = procedure(Sender: TObject; Message: TLMessage) of object;
TDragObject = class
private
@@ -1084,6 +1085,7 @@
FOnEditingDone: TNotifyEvent;
FOnEndDock: TEndDragEvent;
FOnEndDrag: TEndDragEvent;
+ FOnMessage: TMessageEvent;
FOnMouseDown: TMouseEvent;
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
@@ -1410,6 +1412,7 @@
property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver;
property OnEndDock: TEndDragEvent read FOnEndDock write FOnEndDock;
property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag;
+ property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
Index: lcl/grids.pas
===================================================================
--- lcl/grids.pas (revision 51225)
+++ lcl/grids.pas (working copy)
@@ -1412,6 +1412,7 @@
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
+ property OnMessage;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
@@ -1521,6 +1522,7 @@
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
+ property OnMessage;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
@@ -1742,6 +1744,7 @@
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
+ property OnMessage;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
Index: lcl/include/control.inc
===================================================================
--- lcl/include/control.inc (revision 51225)
+++ lcl/include/control.inc (working copy)
@@ -2029,6 +2029,7 @@
var
Form : TCustomForm;
begin
+ if Assigned(FOnMessage) then FOnMessage(Self, TheMessage);
//DebugLn('CCC TControl.WndPRoc ',Name,':',ClassName);
if (csDesigning in ComponentState) then
begin
-------------- next part --------------
A non-text attachment was scrubbed...
Name: stringgridequal.zip
Type: application/x-zip-compressed
Size: 2328 bytes
Desc: not available
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20160108/39f7cf08/attachment-0002.bin>
More information about the Lazarus
mailing list