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

Mattias Gaertner nc-gaertnma at netcologne.de
Thu Jun 5 18:52:40 CEST 2008


On Thu, 5 Jun 2008 03:00:04 +0300
"Kostas Michalopoulos" <badsector at slashstone.com> wrote:

> 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.

Thanks. Applied.

Mattias



More information about the Lazarus mailing list