Jump to content
Mike Warren

Zooming At Mouse Position

Recommended Posts

I don't know what I'm doing wrong, but I can't seem to get this to work properly.

 

For each page (TFrame) I have a TScrollBox that contains a number of  Layers (TScaledLayout), which in turn contain a bunch of components.

 

I zoom in and out using the mouse wheel and want the position of the frame to remain visually locked to the mouse cursor as I zoom. What I thought would work would be to change the Scrollbox.ViewportPosition as I zoom, but this produces a non-linear movement (a strange curve). Each step of the mouse wheel changes the zoom in 10% increments. Here's the code:

if WheelDelta > 0 then
  begin
    Z := CurrentPage.Zoom + 0.1;
    if Z > 4 then
      Z := 4
    else
      CurrentPage.sbView.ViewportPosition := CurrentPage.sbView.ViewportPosition * 1.1;
  end else begin
    Z := CurrentPage.Zoom - 0.1;
    if Z < 0.1 then
      Z := 0.1
    else
      CurrentPage.sbView.ViewportPosition := CurrentPage.sbView.ViewportPosition / 1.1;
  end;
  CurrentPage.Zoom := Z;

This is the Zoom code:

procedure TfrmPage.SetZoom(const Value: Single);
var
  I: Integer;
begin
  FZoom := Value;
  for I := 0 to LayerCount -1 do
    Layers[I].Zoom := FZoom; 
end;

// The layer frame is not shown. Instead, the ScaledLayouts are parented to the page frame's scrollbox
procedure TfrmLayer.SetZoom(const Value: Single);
begin
  FZoom := Value;
  slContent.Width := slContent.OriginalWidth * FZoom;
  slContent.Height := slContent.OriginalHeight * FZoom;
end;

 

The video below shows what happens. What am I doing wrong?

 

 

 

Edited by Mike Warren

Share this post


Link to post

How is your code supposed to work since you don't use at all the mouse position in the code?

Share this post


Link to post
2 hours ago, dwrbudr said:

How is your code supposed to work since you don't use at all the mouse position in the code?

Good point. This is simplified because I couldn't get it to work in a way that makes sense to me.

 

I have a member that gets set in the page's MouseMove event:

FMouseOnPage: TPointF

 

But I took that out for testing, expecting the zoom to at least stay centred. But It does that weird curve.

 

Share this post


Link to post

Okay, this seems to work:

var 
  P1, P2: TPointF;
begin
  // Mouse location on page before zoom
  P1 := (sbView.ScreenToLocal(Screen.MousePos) + sbView.ViewportPosition) / CurrentPage.Zoom;

  if WheelDelta > 0 then
  begin
    Z := CurrentPage.Zoom + 0.1;
    if Z > 4 then Z := 4;
  end else begin
    Z := CurrentPage.Zoom - 0.1;
    if Z < 0.1 then Z := 0.1;
  end;

  // Mouse location on page after zoom
  P2 := (sbView.ScreenToLocal(Screen.MousePos) + sbView.ViewportPosition) / Z;

  sbView.ViewportPosition := sbView.ViewportPosition + ((P1 - P2) * Z);

  CurrentPage.Zoom := Z;

 

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×