[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