[Lazarus] OnMouseWheel[Down/Up] support in TControl (patch included)

Kostas Michalopoulos badsector at slashstone.com
Thu Jun 5 02:49:02 CEST 2008


And, um, the patch :-P
  ----- Original Message ----- 
  From: Kostas Michalopoulos 
  To: General mailing list 
  Sent: Thursday, June 05, 2008 3:00 AM
  Subject: [Lazarus] OnMouseWheel[Down/Up] support in TControl (patch included)


  I'm making a 3D design program and i use TPaintBox to draw the 2D viewports. I want to make the program zoom in/out using the wheel, however although all other mouse events are supported OnMouseWheelUp/Down are not. I noticed that the TPaintBox is a descendant of TGraphicControl, which doesn't provide these events and TWinControl is where the code for these is written. So i tried to move the code from TWinControl up to TControl so all controls can receive them, much like they receive OnMouseDown/Up etc. But it didn't worked, because after some checks i figured out that the message wasn't sent to the correct control (there wasn't done proper translation of the mouse coordinates from screen to client space). So i added a couple of lines in WMMouseWheel function in TControl (moved from TWinControl) that re-checks for the proper control under mouse using FindLCLControl and calls the DoMouseWheel function of that control (or the Self control if FindLCLControl returns nil).

  This solved the problem and now all TControls can use OnMouseWheel* events. However while doing my tests i saw that calling ScreenToClient in a TForm the coordinates remain intact. I am not sure if this is the original issue of improper translations, since right now i'm way too tired (spent around four hours trying to fix this) to check, but i might check it tomorrow (well, also i don't know if this is a bug or a design decision).

  In any case since i have a properly working (although a little hacky) patch for making wheel events usable for non-TWinControls, i'm attaching it. The patch is against SVN revision 15308.

  Kostas



------------------------------------------------------------------------------


  _______________________________________________
  Lazarus mailing list
  Lazarus at lazarus.freepascal.org
  http://www.lazarus.freepascal.org/mailman/listinfo/lazarus
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20080605/5e1e36e1/attachment-0007.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: tcontrol-mousewheel-support.patch
Type: application/octet-stream
Size: 10918 bytes
Desc: not available
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20080605/5e1e36e1/attachment-0007.obj>


More information about the Lazarus mailing list