Code archives/Algorithms/Zooming In/Out

This code has been declared by its author to be Public Domain code.

Zooming In/Out by Cruis.In

2005

Cool for space games, zoom in out of the action.
All you do is apply +newscale to any setscale command.
For example.

setscale(1.0 + newscale, 1.0 + newscale)
drawimage (image, x,y)

setting 1.0 always ensures the image loads at its normal scale, and only applies newscale based on how much you zoom in or out with the mouse wheel.
1.0 could even by a variable. like DefaultScale.
Default_Scale = 1.0

setscale (default_scale + newscale, default_scale + newscale)

so you could have different variables for different images if you want them loaded bigger or smaller by default.

The zoom has a little catch up, if you scroll the wheel like 5 clicks fast, it zoom as you do that, and continue on a little after you stopped. Makes it smooth and cool

1500@... if any questions.

Strict
Graphics 800,600,0

Global newscale:Float


While Not KeyHit(KEY_ESCAPE)
Cls
		
	SetColor(244,122,134)
	SetScale(1.0 + newscale,1.0 + newscale)
	
	'handle cube by the centre
	SetHandle(50,50)
	DrawRect(400,300,100,100)
	
	'call function
	zoomcamera()
	
Flip

Wend

Function ZoomCamera()
	Local MaxZoom:Float  =  3.0
	Local minzoom:Float  = -0.8
	Local speed:Float    = 0.03
	Local set_Zoom:Float
	Local zoom			
	
	'mouse wheel value = to variable zoom
	zoom = MouseZ()
	 
    'so that it doesn't zoom in whole numbers( which wouldn't be smooth)

	set_Zoom = 0.2 * zoom 
	

	'limit max zoom in		
	If set_Zoom > maxZoom
		Set_Zoom = maxZoom
	End If 
	
	'zooms to the set zoom value(determined by how much you scroll)		
	If KeyDown(KEY_Z) = 0 And set_Zoom > newScale
		newscale :+ speed 
	End If
	
	'same as above 	
	If KeyDown(KEY_X) = 0 And set_Zoom < newScale
		newscale :- speed 		
	End If
	
	'limit zoom out		
	If newscale < minZoom
		newscale = minZoom
	End If
	
	SetColor(100,100,100)
	SetScale(1.0,1.0)
	DrawText("Newscale: "+newscale,100,100)
End Function

Comments

Cruis.In

2005

this is the correct one .BMX
sorry can an admin delete, the .BB one?

klepto2

2005

I have changed your Code a little bit so it zooms immediatly if you scroll the MouseWheel. I hope you have nothing against it.

Otherwise it is a nice piece of Code (very useful for me)

Function ZoomCamera(_Map:TTileMap)

	Local MaxZoom:Float  =  10.0
	Local minzoom:Float  = 0.0
	Local speed:Float    = 0.2
	Local set_Zoom:Float
	Local zoom
	Local OldMZ
	Local MZ 
	Local zoomMax = MaxZoom / 0.2 

	OldMZ = MZ
	MZ = MouseZ()
	'Print MZ + " : " + OldMZ + " : " + (MZ - OldMZ)		
	'mouse wheel value = to variable zoom
	zoom = zoom + (MZ - OldMZ)
	'Print Zoom 
    'so that it doesn't zoom in whole numbers( which wouldn't be smooth)

	set_Zoom = 0.2 * zoom 

	'limit max zoom in		
	If set_Zoom > maxZoom
		Set_Zoom = maxZoom
		zoom = zoomMax
	End If 
	
	'zooms to the set zoom value(determined by how much you scroll)		
	If KeyDown(KEY_Y) = 0 And set_Zoom > newScale

		newscale :+ speed 
	End If
	
	'same as above 	
	If KeyDown(KEY_X) = 0 And set_Zoom < newScale
		newscale :- speed 		
	End If
	
	'limit zoom out		
	If newscale < minZoom
		newscale = minZoom
		zoom = minzoom/0.2
	End If

	SetScale(1.0,1.0)
End Function

Cruis.In

2006

aren't you famous around here, I cant believe code I did is useful to you. I should have kept this up.

Cruis.In

2006

just curious, what is it useful to you for. And since ive started back coding, can I ask you for some help in my project, mainly consultative?

Cruis.In

2006

for HK if he looks here, run this code, i have put two rects in now. you will see the problem i mean. going closer together.

Strict
Graphics 800,600,0

Global newscale:Float


While Not KeyHit(KEY_ESCAPE)
Cls
		
	SetColor(244,122,134)
	SetScale(1.0 + newscale,1.0 + newscale)
	
	'handle cube by the centre
	SetHandle(50,50)
	DrawRect(500,300,100,100)
	
	SetHandle(50,50)
	DrawRect(100,300,100,100)

	'call function
	zoomcamera()
	
Flip

Wend

Function ZoomCamera()
	Local MaxZoom:Float  =  3.0
	Local minzoom:Float  = -0.8
	Local speed:Float    = 0.03
	Local set_Zoom:Float
	Local zoom			
	
	'mouse wheel value = to variable zoom
	zoom = MouseZ()
	 
    'so that it doesn't zoom in whole numbers( which wouldn't be smooth)
	set_Zoom = 0.2 * zoom 
	

	'limit max zoom in		
	If set_Zoom > maxZoom
		Set_Zoom = maxZoom
	End If 
	
	'zooms to the set zoom value(determined by how much you scroll)		
	If KeyDown(KEY_Z) = 0 And set_Zoom > newScale
		newscale :+ speed 
	End If
	
	'same as above 	
	If KeyDown(KEY_X) = 0 And set_Zoom < newScale
		newscale :- speed 		
	End If
	
	'limit zoom out		
	If newscale < minZoom
		newscale = minZoom
	End If
	
	SetColor(100,100,100)
	SetScale(1.0,1.0)
	DrawText("Newscale: "+newscale,100,100)
End Function

bradford6

2006



While Not KeyHit(KEY_ESCAPE)
AutoMidHandle(True)
Cls
		
	SetColor(244,122,134)
	SetScale(1.0 + newscale,1.0 + newscale)
	
	
	DrawScaleRect(500,300,100,100,newscale+1.0)
	DrawScaleRect(100,300,100,100,newscale+1.0)


	'call function
	zoomcamera()
	
Flip

Wend

Function DrawScaleRect(x#,y#,wide#,Hite#,Scale#)
	'handle cube by the centre
	
	DrawRect(x*Scale#,y*Scale,Wide*Scale,Hite*Scale)
		
	
End Function
Function ZoomCamera()
	Local MaxZoom:Float  =  3.0
	Local minzoom:Float  = -0.8
	Local speed:Float    = 0.03
	Local set_Zoom:Float
	Local zoom			
	
	'mouse wheel value = to variable zoom
	zoom = MouseZ()
	 
    'so that it doesn't zoom in whole numbers( which wouldn't be smooth)
	set_Zoom = 0.2 * zoom 
	

	'limit max zoom in		
	If set_Zoom > maxZoom
		Set_Zoom = maxZoom
	End If 
	
	'zooms to the set zoom value(determined by how much you scroll)		
	If KeyDown(KEY_Z) = 0 And set_Zoom > newScale
		newscale :+ speed 
	End If
	
	'same as above 	
	If KeyDown(KEY_X) = 0 And set_Zoom < newScale
		newscale :- speed 		
	End If
	
	'limit zoom out		
	If newscale < minZoom
		newscale = minZoom
	End If
	
	SetColor(100,100,100)
	SetScale(1.0,1.0)
	DrawText("Newscale: "+newscale,100,100)
End Function

DJWoodgate

2007

Here is my take on it. Pans the draw area using setorigin and stops the rects getting closer together by scaling the draw position. Implements a slightly different zoom function which acccepts Min Zoom, Max Zoom, Resolution and number of steps to achieve a target zoom at this resolution by using the mousewheel. This calls a MouseZspeed function similar to the old Blitz one, but which accepts a speed modifier.

Strict
Graphics 800,600

Type Layout
	Field Xpos,Ypos,Width,Height
	
	Global list:TList
	Function Create:TList(Hsize,Vsize,Hgap,Vgap)
	
		If list<>Null Then ClearList(list) ; list=Null
	
		list:TList = CreateList()
	
		Local cols = GraphicsWidth()/(Hsize+Hgap)
		Local rows = GraphicsHeight()/(Vsize+Vgap)
		Local Hctr = (GraphicsWidth()-(Hsize+Hgap)*cols)*0.5
		Local Vctr = (GraphicsHeight()-(Vsize+Vgap)*rows)*0.5	
	
		For Local i=0 To rows-1
			For Local j=0 To cols-1
				
				Local photo:Layout = New Layout
			
				photo.Xpos = Hctr+Hsize/2+(Hsize+Hgap)*j
				photo.Ypos = Vctr+Vsize/2+(Vsize+Vgap)*i
				photo.Width = Hsize
				photo.Height = Vsize
				
				ListAddLast list,photo
			Next
		Next
		Return list
	End Function
	
	Function DrawBackground(r,g,b)
		Local blend=GetBlend(), Alpha#=GetAlpha()
		SetBlend alphablend; SetAlpha 0.5; SetColor r,g,b
		For Local i=0 To GraphicsWidth()-1 Step 32
			DrawRect i,0,16,GraphicsHeight()
		Next
		For Local i=0 To GraphicsHeight()-1 Step 32
			DrawRect 0,i,GraphicsWidth(),16
		Next
		SetBlend blend; SetAlpha alpha
	End Function
	
	
	Method DrawPicture(Mx,My)
		Local sx#,sy#,ox#,oy#,hx#,hy#
		GetScale (sx,sy); GetHandle (hx,hy); GetOrigin (ox,oy)
		SetOrigin GraphicsWidth()/2.0-mx*sx,GraphicsHeight()/2.0-my*sy
		SetHandle width/2.0,height/2.0 
		DrawRect sx*xpos,sy*ypos,width,height
		SetOrigin ox,oy; SetHandle hx,hy
	End Method
End Type

Local list:TList = layout.create(150,100,5,5)

MoveMouse GraphicsWidth()/2,GraphicsHeight()/2

While Not KeyHit(KEY_ESCAPE)
Cls
	Local mx=MouseX()
	Local my=MouseY()
	Local scale#=mousezoomvalue()
	
	layout.drawbackground(100,100,100)
	
	SetScale scale,scale 
	
	For Local photo:layout = EachIn list
		SetColor Photo.xpos,photo.ypos,photo.xpos-photo.ypos
		photo.drawpicture(Mx,My)
	Next
	
	SetColor(200,200,200); SetScale(1.0,1.0); SetHandle 0,0
	DrawText("New scale: "+scale,10,10)
	
Flip

Wend

Function MouseZoomValue#(MinZoom#=0.2,MaxZoom#=5.0, resolution#=0.1, Steps#=20)
	Global zoom#=1.0, target#=1.0
	Local epsilon#,tdelta#

	steps = Max(steps,1)
	epsilon = resolution/steps
	target = Max(Min(target+(MouseZspeed(resolution)),maxzoom),minzoom)

	Tdelta = target-zoom	
	If Abs(Tdelta)<epsilon Then zoom = target Else zoom = zoom + Tdelta/steps 

	Return zoom
End Function

Function MouseZSpeed#(speed_modifier#=1.0)
	Global Lastz,Newz
	Lastz = Newz
	Newz = MouseZ()
	Return (Newz-Lastz)*speed_modifier
End Function

Code Archives Forum