Pan and Zoom 2D with mouse (solved)

General FreeBASIC programming questions.
Post Reply
mrToad
Posts: 430
Joined: Jun 07, 2005 23:03
Location: USA
Contact:

Pan and Zoom 2D with mouse (solved)

Post by mrToad »

Edit: solved below :)

I'm having trouble with zooming (using scroll wheel) in and out of a 2D image based on mouse position, just like you would see in any paint program. I've got the panning alone working - holding middle mouse button allows you to pan around, but zoom is wonky.

Edit: New code pasted below to show you how the zoom doesn't work well. Imagine if you were trying to zoom in to a particular point on the square. It seems to work but goes adrift soon enough.

Code: Select all

#Include "fbgfx.bi"

#Define RES_W 1280
#Define RES_H 720

Dim As Integer mx,my,ms,mb, old_ms
Dim As Integer zoom, pan_x, pan_y, old_pan_x, old_pan_y, grabbed, mGrabx, mGraby

ScreenRes(res_w,res_h,32,,0)

pan_x = 400
pan_y = 200
Zoom = 1

Do
   GetMouse mx,my,ms,mb

	If ms <> old_ms Then

		Zoom = ms + 1
		If Zoom < 1 Then Zoom = 1
		If Zoom > 60 Then Zoom = 60
	
		If ms > old_ms Then
			'' Still a wonky zoom but closest I can get.
			'' Divide the zoom amount by the same ratio as mouse is to screen edge and adjust pan by that amount.
			pan_x -= ((res_w * .1) / (res_w/(-pan_x+mx)) )
			pan_y -= ((res_h * .1) / (res_h/(-pan_y+my)) )
		ElseIf ms < old_ms Then
			pan_x += ((res_w * .1) / (res_w/(-pan_x+mx)) )
			pan_y += ((res_h * .1) / (res_h/(-pan_y+my)) )
		EndIf
	
		old_ms = ms
	EndIf

	If mb = 0 Then
   		grabbed = FALSE
	ElseIf mb = 4 Then
		If grabbed = FALSE Then
			old_pan_x = pan_x
			old_pan_y = pan_y
   	        mGrabx = mx
   	        mGraby = my
			grabbed = TRUE
		Else
			pan_x = old_pan_x + -(mGrabx - mx)
			pan_y = old_pan_y + -(mGraby - my)
		End If
	End If

	If pan_x < 0 Then pan_x = 0
	If pan_y < 0 Then pan_y = 0
	If pan_x > res_w-Zoom*10 Then pan_x = res_w-Zoom*10
	If pan_y > res_h-Zoom*10 Then pan_y = res_h-Zoom*10

	ScreenLock
		Cls
		Locate 1,1,0
		Print "Center mouse button to pan, scroll to zoom, q to quit"
		Print "pan_x: "; pan_x
		Print "pan_y: "; pan_y
		Print "zoom:  "; zoom
		Print "mx,my: "; mx,my
		Print "mb:    "; mb
		Print "ms:    "; ms
		Line (pan_x,pan_y)-(pan_x+(10*Zoom),pan_y+(10*Zoom)),RGB(255,100,100),bf
	ScreenUnLock
	
	Sleep(1,1)
	
Loop Until InKey = "q"
This zoom scale of the box starts from the upper-left corner. So pan_x and pan_y have to adjust with that in mind.

So the simple goal here is for the increased/decreased zoom to be divided into all four directions appropriately in order to maintain focus on point at which the mouse x/y was hovering just before scroll wheel rotation. For example, if mouse cursor is all the way at (or beyond) the upper-left corner of image, all zoom/scale is extended at the right and bottom of image. In contrast, if cursor is somewhere near bottom-right corner of image, most of the zoom/scale is extended at upper-left sides, but a fraction of it is also extended at the other sides. This way focal point under the cursor is never moved during scaling.

I've tried awhile tinkering around. The solution is probably pretty easy, I'm just not thinking clear.

If you have ideas, I'd be interested and thankful. :)
Last edited by mrToad on Oct 17, 2019 23:50, edited 4 times in total.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: Pan and Zoom 2D with mouse

Post by grindstone »

Whatever the origin of your trouble may be, the polling of the mouse wheel surely in't:

Code: Select all

#Define RES_W 1920
#Define RES_H 1080

Static As Integer old_ms
Dim As Integer mx,my,ms,mb
Dim As Double zoom, pan_x, pan_y

Do
	GetMouse mx,my,ms,mb

	If ms <> old_ms Then

		Zoom = (ms+4) / 4 '' Zoom in increments of .25
		If Zoom < .25 Then Zoom = .25
		If Zoom > 50 Then Zoom = 50

		If ms > old_ms Then
			'' Still a wonky zoom but closest I can get.
			'' Divide the zoom amount by the same ratio as mouse is to screen edge and adjust pan by that amount.
			pan_x -= ((res_w * .25) / (res_w/(-pan_x+mx)) )
			pan_y -= ((res_h * .25) / (res_h/(-pan_y+my)) )
		ElseIf ms < old_ms Then
			pan_x += ((res_w * .25) / (res_w/(-pan_x+mx)) )
			pan_y += ((res_h * .25) / (res_h/(-pan_y+my)) )
		EndIf

		old_ms = ms
	EndIf
	Locate 1,1,0
	Print pan_x;"   "
	Print pan_y;"   "
	Print zoom;"    "

Loop
As you see, the zoom factor is computed correctly.
mrToad
Posts: 430
Joined: Jun 07, 2005 23:03
Location: USA
Contact:

Re: Pan and Zoom 2D with mouse (new code example)

Post by mrToad »

I updated the original post with some working code. Imagine that you are trying to zoom in on a certain part of the square. In most paint software, the image is scaled out from the point of the mouse cursor proportionately. I just need some better math.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Pan and Zoom 2D with mouse (new code example)

Post by BasicCoder2 »

Maybe something like this. In the source code just change the image you want to load and its dimensions.
Use the keys, 1 to 9 to change the magnification.
It would be easy enough to replace the key commands with the mouse wheel to change magnifications.

Code: Select all

#include "fbgfx.bi"
' D.J.Peters imageScale code
Function ImageScale(s As fb.Image Ptr, Scale as single=1.0) As fb.Image Ptr
  static As fb.Image Ptr t=0
  If s        =0 Then Return 0
  If s->width <1 Then Return 0
  If s->height<1 Then Return 0
  scale=abs(scale)
  dim as integer w = s->width *Scale
  dim as integer h = s->height*Scale
  If w<4 Then w=4
  If h<4 Then h=4
  if t then ImageDestroy(t) : t=0
  t=ImageCreate(w,h)
  Dim As Integer xs=(s->width /t->Width ) * (1024*64)
  Dim As Integer ys=(s->height/t->height) * (1024*64)
  Dim As Integer x,y,sy
  Select Case As Const s->bpp
    Case 4
      Dim As Ulong Ptr ps=cptr(Ulong Ptr,s)+8
      Dim As Uinteger     sp=(s->pitch Shr 2)
      Dim As Ulong Ptr pt=cptr(Ulong Ptr,t)+8
      Dim As Uinteger     tp=(t->pitch Shr 2)-t->width
      For ty As Integer = 0 To t->height-1
        Dim As Ulong Ptr src=ps+(sy Shr 16)*sp
        For tx As Integer = 0 To t->width-1
          *pt=src[x Shr 16]:pt+=1:x+=xs
        Next
        pt+=tp:sy+=ys:x=0
      Next
    Case 2
      Dim As Ushort Ptr ps=cptr(Ushort Ptr,s)+16
      Dim As Uinteger   sp=(s->pitch Shr 1)
      Dim As Ushort Ptr pt=cptr(Ushort Ptr,t)+16
      Dim As Uinteger   tp=(t->pitch Shr 1)-t->width
      For ty As Integer = 0 To t->height-1
        Dim As Ushort Ptr src=ps+(sy Shr 16)*sp
        For tx As Integer = 0 To t->width-1
          *pt=src[x Shr 16]:pt+=1:x+=xs
        Next
        pt+=tp:sy+=ys:x=0
      Next
    Case 1
      Dim As Ubyte Ptr ps=cptr(Ubyte Ptr,s)+32
      Dim As Uinteger   sp=s->pitch
      Dim As Ubyte Ptr pt=cptr(Ubyte Ptr,t)+32
      Dim As Uinteger   tp=t->pitch-t->width
      For ty As Integer = 0 To t->height-1
        Dim As Ubyte Ptr src=ps+(sy Shr 16)*sp
        For tx As Integer = 0 To t->width-1
          *pt=src[x Shr 16]:pt+=1:x+=xs
        Next
        pt+=tp:sy+=ys:x=0
      Next
  End Select
  Return t
End Function


screenres 1280,600,32
color rgb(0,0,0),rgb(255,255,255):cls

const IMGW = 4608
const IMGH = 3456

dim shared as any ptr img
img = imagecreate(IMGW,IMGH)
bload "bigPic.bmp",img
circle img,(IMGW/2,IMGH/2),5,rgb(255,0,0),,,,f

dim shared as any ptr tmp
tmp = imagecreate(400,400)  'display size

sub drawImage(mag as integer,midx as integer, midy as integer)
    screenlock
    cls
    line tmp,(0,0)-(399,399),rgb(255,0,255),bf  'clear
    put tmp,(0,0),img,( midx-(200/mag), midy-(200/mag))-( midx+(200/mag), midy+(200/mag)),trans
    put (0,0),ImageScale(tmp,mag),trans
    screenunlock
end sub

dim as integer mag
mag = 2

dim as integer midx, midy   'position of mouse in main image
midx = 2304
midy = 1728

dim as integer mx,my,ox,oy,mb,dx,dy

mag = 4
dim as string key

drawImage(mag,midx,midy)

do
    key = inkey
    
    if key >= "1" and key <= "9" then
        mag = val(key)
    end if

    drawImage(mag,midx,midy)
                
    getmouse mx,my,,mb

    if mb = 1 then
        ox = mx/mag
        oy = my/mag
        while mb = 1
            getmouse mx,my,,mb
            mx = mx/mag
            my = my/mag
            if ox<>mx or oy<>my then 'mouse moved
                dx = ox-mx
                dy = oy-my
        
                midx = midx + dx
                midy = midy + dy

                drawImage(mag,midx,midy)

                ox = mx
                oy = my
            end if
            sleep 2
        wend
    end if
    
    sleep 2
        
loop until multikey(&H01)
mrToad
Posts: 430
Joined: Jun 07, 2005 23:03
Location: USA
Contact:

Re: Pan and Zoom 2D with mouse (new code example)

Post by mrToad »

I appreciate the reply and the time taken to provide the code, BasicCoder2. I know your method works, but my code depends on scaling from upper-left corner, at least to avoid a lot of other work. It's not just a single image that is zooming, but a bunch of slices and markers over the image as well. They could probably all zoom from a center point but that's a different headache :)

It would seem that being this close, it should just be a matter of a little proper math to solve the issue. It's definitely a brain bender for me, though! What I thought was fairly simple and would take less than an hour, has been several hours, with no decent results :)

The trouble is in this one basic line of math - for if this worked, all three other lines of math would be similar and easy:

Code: Select all

pan_x -= ((res_w * .1) / (res_w/(-pan_x+mx)) )
This probably needs to include the relationship between the mouse and the image itself, rather than just the screen. If the mouse is outside the bounds of the image, it must be treated as on the edge of it.

Now my brain is acting like I need to teach the reader how this should work, which might be helping me out! However, after I've spent so much time on it, I wanted to open it up to the sharper math minds out there.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Pan and Zoom 2D with mouse (new code example)

Post by BasicCoder2 »

mrToad wrote: It's not just a single image that is zooming, but a bunch of slices and markers over the image as well.
Well in the first post you wrote "like a paint program". Clearly I have no idea what you are actually trying to do so it is impossible to even think about it. No idea what you mean by "not just a single image" or "bunch of slices and markers over the image as well".

The PAINT program that comes with Windows has to be put in magnify mode and then the image can increase or decrease in size by using the left and right mouse buttons while the scrolling is done by sliders. What paint program has the behaviors you wish to emulate?
mrToad
Posts: 430
Joined: Jun 07, 2005 23:03
Location: USA
Contact:

Re: Pan and Zoom 2D with mouse (new code example)

Post by mrToad »

Sorry for the confusion. It's just the zoom effect of most paint/graphics programs I wished to imitate. Anyway, I finally got it now! Here's the code:

Code: Select all

#Include "fbgfx.bi"

#Define RES_W 1280
#Define RES_H 720

Dim As Integer mx,my,ms,mb, old_ms
Dim As Integer zoom, pan_x, pan_y, old_pan_x, old_pan_y, grabbed, mGrabx, mGraby, wid
Dim As Integer imx, imy

ScreenRes(res_w,res_h,32,,0)

pan_x = 400
pan_y = 200
Zoom = 1

Do
	GetMouse mx,my,ms,mb

	imx = -pan_x + mx
	imy = -pan_y + my

	If imx < 0 Then imx = 0
	If imy < 0 Then imy = 0
	If imx > wid Then imx = wid
	If imy > wid Then imy = wid

	If ms <> old_ms Then

		Zoom = ms + 1
		If Zoom < 1 Then Zoom = 1
		If Zoom > 60 Then Zoom = 60
		
		wid = Zoom * 10
		
		If ms > old_ms Then
			pan_x -= (imx/Zoom)
			pan_y -= (imy/Zoom)
		ElseIf ms < old_ms Then
			pan_x += (imx/Zoom)
			pan_y += (imy/Zoom)
		EndIf

		old_ms = ms
	EndIf

	If mb = 0 Then
   		grabbed = FALSE
	ElseIf mb = 4 Then
		If grabbed = FALSE Then
			old_pan_x = pan_x
			old_pan_y = pan_y
   	        mGrabx = mx
   	        mGraby = my
			grabbed = TRUE
		Else
			pan_x = old_pan_x + -(mGrabx - mx)
			pan_y = old_pan_y + -(mGraby - my)
		End If
	End If

	If pan_x < 0 Then pan_x = 0
	If pan_y < 0 Then pan_y = 0
	If pan_x > res_w-wid Then pan_x = res_w-wid
	If pan_y > res_h-wid Then pan_y = res_h-wid

	ScreenLock
		Cls
		Line (pan_x,pan_y)-(pan_x+wid,pan_y+wid),RGB(255,100,100),bf
		Locate 1,1,0
		Print "Center mouse button to pan, scroll to zoom, q to quit"
		Print "pan_x/y: "; pan_x, pan_y
		Print "mx/my:   "; mx,my
		Print "imx/imy: "; imx,imy
		Print "zoom:    "; zoom
		Print "mb:      "; mb
		Print "ms:      "; ms
	ScreenUnLock
	
	Sleep(1,1)
	
Loop Until InKey = "q"
You will see here that zoom spread direction is relative to the mouse position and the box. It was very simple after all, but I just couldn't see it.
Post Reply