[bmx] Zoom-to-Mousewheel routine (2D) by USNavyFish [ 1+ years ago ]

[BlitzBot]

Title : Zoom-to-Mousewheel routine (2D)
Author : USNavyFish
Posted : 1+ years ago

Description : The most important thing here is how objects are drawn to the screen.   Check out the 'draw' method of my 'obj' type.
Use the Mousewheel to zoom in / out, centered upong location of cursor.   Click and drag to pan.  Double clicking instantly zooms full-in on the mouse cursor.
Please note that it may be used without MaxGUI, but you'll have to modify the code manually to input your desired screen resolution.  The code below uses MaxGUI's GadgetWidth(Desktop()) to pick the desktop's native resolution automatically, but this is simply a convenience function and non essential to the program.  You must enter Resolution width and height into GW and GH variables, respectively.

Code :

Code (blitzmax) Select Expand

SuperStrict

Framework BRL.GLMax2D
Import BaH.Random
Import maxgui.drivers
Import BRL.PNGLoader
Import BRL.BMPLoader


Type obj
Global List:TList

Field X:Float
Field Y:Float
Field Size:Float
Field HalfSize:Float
Field R:Int
Field G:Int
Field B:Int



Method New()
X = Rand(0 , GW)
Y = Rand(0 , GH)
Size = Rnd(0 , 1)
Size = size^3
HalfSize = Size / 2.0
R = Rand(0,255)
G = Rand(0,255)
B = Rand(0 , 255)

If Not List Then List = New TList

List.AddLast(Self)

End Method

Method Draw(ZoomOriginX:Float,ZoomOriginY:Float,_VIEWSCALE:Float)
SetColor(r,g,b)
Local drawx:Float = ( (X - ZoomOriginX  ) * _viewscale)
Local drawy:Float = ((Y- ZoomOriginY ) * _viewscale)
DrawRect(drawX-HalfSize,drawY-HalfSize,size+1,size+1)
End Method

End Type







Global GW:Int = ClientWidth(Desktop())
Global GH:Int = ClientHeight(Desktop())
Global GHW:Float = GW/2.0
Global GHH:Float = GH/2.0


Global Dragging:Byte = 0
Global MSX:Int
Global MSY:Int
Global MPosX:Int
Global MPosY:Int
Global DoubleClickTime:Int
Global DoubleClickDelay:Int = 300

Global Viewscale:Float = 1.0
Global WorldViewOriginX:Float = GHW
Global WorldViewOriginY:Float = GHH

Global ZoomTargetX:Float = GHW
Global ZoomTargetY:Float = GHH
Global ZoomTargetScale:Float = 1
Global ZoomFactor:Float = 1.25
Global ZoomMAX:Float = 30.0
Global ZoomMin:Float = 0.50


'Global RootDir:String = CurrentDir()



AddHook EmitEventHook, EventHook


SetGraphicsDriver(GLMax2DDriver() )


?Debug
Global GraphicsContext:TGraphics = CreateGraphics(GW , GH , 0 , 60 , Graphics_BACKBUFFER)
?Not Debug
Global GraphicsContext:TGraphics = CreateGraphics(GW , GH , 32 , 60 , Graphics_BACKBUFFER)
?

SetGraphics(GraphicsContext)


HideMouse()


For Local i:Int = 0 To 3000
Local temp:obj = New obj
Next



Local ms:Int,time:Int,dt:Float

While Not KeyHit(KEY_ESCAPE)
'ms = MilliSecs()
'dt = ms - time
'time = ms

'Print 1000.0/dt



Cls

SetScale(1 , 1)
SetOrigin(GHW,GHH)




SetColor(255 , 255 , 0)
SetLineWidth(5)
Local tempx:Float = (-WorldViewOriginX * viewscale)
Local tempy:Float = (-WorldViewOriginY * viewscale )
Local tempx2:Float = tempx+(GW*viewscale)
Local tempy2:Float = tempy+(GH*viewscale)

DrawLine(tempx , tempy , tempx2 , tempy)
DrawLine(tempx2, tempy , tempx2 , tempy2)
DrawLine(Tempx2 , tempy2 , tempx , tempy2)
DrawLine(tempx , tempy2 , tempx , tempy)
SetLineWidth(1)
SetColor(255 , 255 , 255)


SetViewScale()


For Local t:obj = EachIn Obj.List
t.draw(WorldViewOriginX, WorldViewOriginY, viewscale)

Next


SetScale(1 , 1)
SetOrigin(0 , 0)


SetBlend(LightBlend)
SetAlpha(0.4)
SetColor(255 , 155 , 0)
SetLineWidth(2)

DrawLine(MPosX- 15 , MPosY, MPosX+ 15 , MPosY)
DrawLine(MPosX, MPosY- 15 , MPosX, MPosY+ 15 )


SetLineWidth(1)
SetBlend(SolidBlend)



SetColor(255 , 255 , 255)
DrawText("SCALE:  " + viewscale , 50 , 50)

Flip 0

Wend





Function SetViewScale()


WorldViewOriginX = ZoomTargetX
WorldViewOriginY = ZoomTargetY
ViewScale = ZoomTargetScale

SetScale(Viewscale , Viewscale)

End Function






Function ZoomIn(MouseScreenX:Int , MouseScreenY:Int)

If Not (ZoomTargetScale  >= ZoomMax)

Local mx:Float = (MouseScreenX - GHW) /ZoomTargetScale
Local my:Float = (MouseScreenY - GHH) /ZoomTargetScale
Local z:Float = 1.0 - (1.0/ZoomFactor)

ZoomTargetX = (mx)*(z) + WorldViewOriginX
ZoomTargetY = (my)*(z) + WorldViewOriginY

If ZoomTargetX > GW
ZoomTargetX = GW
Else If ZoomTargetX < 0
ZoomTargetX = 0
EndIf

If ZoomTargetY > GH
ZoomTargetY = GH
Else If ZoomTargetY < 0
ZoomTargetY = 0
EndIf


ZoomTargetScale:* ZoomFactor

If ZoomTargetScale  > ZoomMax Then ZoomTargetScale  = ZoomMax

EndIf


End Function




Function ZoomOut(MouseScreenX:Int , MouseScreenY:Int)

If Not (ZoomTargetScale  =< ZoomMin)

Local mx:Float = (MouseScreenX - GHW) / ZoomTargetScale
Local my:Float = (MouseScreenY - GHH) / ZoomTargetScale
Local z:Float = 1.0 - ZoomFactor

ZoomTargetX  = mx*(z)+ WorldViewOriginX
ZoomTargetY = my*(z)+ WorldViewOriginY

ZoomTargetScale:/ ZoomFactor

If ZoomTargetScale < ZoomMin Then ZoomTargetScale = ZoomMin

EndIf
End Function





Function DoubleClick(button:Int , MouseScreenX:Int , MouseScreenY:Int)
ZoomTargetX = WorldViewOriginX + (MouseScreenX - GHW) / ZoomTargetScale
ZoomTargetY = WorldViewOriginY + (MouseScreenY - GHH) / ZoomTargetScale
ZoomTargetScale = ZoomMax
End Function



Function Drag(MouseScreenX:Int , MouseScreenY:Int)
Local dx:Float = (MouseScreenX - MSX) / viewscale
Local dy:Float = (MouseScreenY - MSY) / viewscale

WorldViewOriginX:- dx
WorldViewOriginY:- dy
ZoomTargetX:- dx
ZoomTargetY:- dy

MSX = MouseScreenX
MSY = MouseScreenY

If WorldViewOriginX < 0
WorldViewOriginX = 0
ZoomTargetX = 0
Else If WorldViewOriginX > GW
WorldViewOriginX = GW
ZoomTargetX = GW
EndIf

If WorldViewOriginY < 0
WorldViewOriginY = 0
ZoomTargetY = 0
Else If WorldViewOriginY > GH
WorldViewOriginY = GH
ZoomTargetY = GH
EndIf


End Function




Function EventHook:Object(ID:Int , Data:Object , Context:Object)
Local Event:TEvent = TEvent(data)
If Event = Null Then Return event

Select event.id
Case EVENT_MOUSEWHEEL

If Event.Data > 0
ZoomIn(event.x,Event.Y)
Else
ZoomOut(event.x,Event.Y)
EndIf


Case EVENT_APPTERMINATE
End


Case EVENT_KEYDOWN
Select Event.Data
Case KEY_ESCAPE End


End Select




Case EVENT_MOUSEDOWN

Local ms:Int = MilliSecs()
If ms - DoubleClickTime =< DoubleClickDelay
DoubleClick(event.Data , event.X , event.Y)
Return Null
Else DoubleClickTime = ms
EndIf

Select Event.data

Case 1
Dragging = 1
MSX = Event.X
MSY = Event.Y


Case 3
Dragging = 1
MSX = Event.X
MSY = Event.Y



End Select


Case EVENT_MOUSEUP
Select Event.data
Case 1,3
Dragging = 0

End Select


Case EVENT_MOUSEMOVE

MPosx = Event.x
MPosY = Event.y

If Dragging
Drag(event.x,event.y)

EndIf


End Select


End Function

Comments :


USNavyFish(Posted 1+ years ago)

 Simplified zoom function.  I'm aware of how poorly documented this is - if you have any questions, please email usnavyfish at gmail dot com.

Code Select Expand

Method Zoom(MouseScreenX:Double , MouseScreenY:Double, amount:Double = 0)
ZoomInProgress = True

If ZoomTargetScale < ZoomMax And ZoomTargetScale >= ZoomMin


Local mx:Double = (MouseScreenX - GHW) /ZoomTargetScale
Local my:Double = (MouseScreenY - GHH) / ZoomTargetScale


Local NewZoom:Double, ZF:Double, Z:Double

ZF = ZoomFactor * Abs(amount)

If amount > 0
NewZoom = ZoomtargetScale * ZF
If NewZoom > ZoomMax Then ZF = 1
z = 1.0 - (1.0/ZF)
ZoomTargetScale:* ZF
Else
NewZoom = ZoomTargetScale / ZF
If  NewZoom < ZoomMin Then ZF = 1
z = 1.0 - ZF
ZoomTargetScale:/ ZF
EndIf


ZoomTargetX:+ (mx)*(z)
ZoomTargetY:+ (my)*(z)


If ZoomTargetX > GW
ZoomTargetX = GW
Else If ZoomTargetX < 0
ZoomTargetX = 0
EndIf

If ZoomTargetY > GH
ZoomTargetY = GH
Else If ZoomTargetY < 0
ZoomTargetY = 0
EndIf

EndIf

ZoomInProgress = False
End Method