Create a TPaintBox that can be scrolled by mouse wheel

Mirror

Create a TPaintBox that can be scrolled by mouse wheel (Views: 716)

Problem/Question/Abstract:

I have a TPaintBox that shows part of my bitmap and I would like to be able to scroll by using the mouse wheel, both up and down and all 4 directions. I assume this needs some message handlers, but have no idea of which ones.

Answer:

The WM_MOUSEWHEEL message is sent to the focus window when the mouse wheel is rotated. As far as I know, it's impossible to do this with a TPaintBox as it's a TGraphicControl descendant and can't receive this message. The solution could be to place it in a scrollbox. Then define OnMouseWheelDown and OnMouseWheelUp event handlers to the scroll box and insert a ScrollBy(..) method call. Also, you'll need your scrollbox to receive the focus. And the last thing is to write a CM_HITTEST message handler for the paint box. In the message result return the HTNOWHERE constant. This will force the parent scrollbox to handle mouse messages on its own. Here's an example:

{ ... }
TMyPaintBox = class(TPaintBox)
protected
  procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
end;

{ ... }

procedure TMyPaintBox.CMHitTest(var Message: TCMHitTest);
begin
  Message.Result := Windows.HTNOWHERE;
end;

Here's how scrollbox events handlers can look like

{scrolls content to the right direction}

procedure TForm1.MyScrollBox1MouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  MyScrollBox1.ScrollBy(5, 0);
end;

{scrolls content to the left}

procedure TForm1.MyScrollBox1MouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  MyScrollBox1.ScrollBy(-5, 0);
end;

{sets focus to the scrollbox}

procedure TForm1.MyScrollBox1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MyScrollBox1.SetFocus;
end;

<< Back to main page