+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: A little demo for camera and zoomer on image (/showthread.php?tid=3532)
A little demo for camera and zoomer on image - TempodiBasic - 03-13-2025
Hi
here a little demo that shows the power of _putimage, building up a camera pointer on an image and a zoomer.
you can copy , save and run the following code
this is the output
![[Image: image.png]](https://i.ibb.co/RGQ6kBNy/image.png)
Code: (Select All)
Rem the idea is to show a piece of image (camera) around the mouse pointer into another canvas using _putimage
Rem a canvas is for the first image and a second canvas is for pointer camera so we can play with _putimage
Rem joining cameraPointer and Zoomer stuff
Dim Lscreen As Long, Limage As Long
Lscreen = _NewImage(800, 600, 32)
Limage = _NewImage(600, 300, 32)
Screen Lscreen
' make the original image object of the zoom
_Dest Limage
Cls
For turn = 1 To 200
Line (1 + Int(Rnd * 600), 1 + Int(Rnd * 300))-(10 + Int(Rnd * 590), 10 + Int(Rnd * 290)), _RGBA32(Int(Rnd * 200), Int(Rnd * 200), Int(Rnd * 200), 255), B
Next turn
_Dest 0
' it makes the window's graphic
_Title "Camera moved by mouse pointer, mouse wheel modifies area camera (pointer Mode) / depth of zoom (zoom Mode)"
Dim As Integer Ix1, Iy1, Ix2, Iy2, Cx1, Cy1, Cside, Mz, Ax1, Ay1, increasing
Dim As String Mmode
Ix1 = 100: Iy1 = 90: Ix2 = 700: Iy2 = 390: Cx1 = 100: Cy1 = 440: Cside = 100: Mz = 10: Mmode = "Pointer"
Ax1 = 0: Ay1 = 0: increasing = 1
Cls , _RGBA32(50, 100, 100, 255)
_PrintString (20, 60), "Original image"
_PrintString (200, 60), "Zoom ratio:" + Str$((increasing)) + " "
_PutImage (Ix1, Iy1)-(Ix2, Iy2), Limage, 0
_PrintString (20, 410), "Image pointed"
Line (Cx1, Cy1)-(Cx1 + Cside, Cy1 + Cside), _RGBA32(255, 255, 255, 255), B
_PrintString (150, 410), "Move mouse on the picture, roll mouse wheel, left click toggle Mode"
Do
If _MouseInput Then
NMx = _MouseX
NMy = _MouseY
If IntheRange(Ix1, Ix2, NMx) And IntheRange(Iy1, Iy2, NMy) Then
AreaCamera NMx, NMy, Cside, Ix1, Iy1, Ix2, Iy2, Ax1, Ay1
' it shows the area of source selected as area of camera
_PutImage (Ix1, Iy1)-(Ix2, Iy2), Limage, 0
Line (Ax1, Ay1)-Step(Cside, Cside), _RGB32(238), B
If _MouseButton(1) Then
' it switches between modes Pointer / Zoomer
If Mmode = "Pointer" Then Mmode = "Zoomer" Else Mmode = "Pointer"
End If
If Mmode = "Pointer" Then
If _MouseWheel < 0 Then
' it draws the background of camera
Line (Cx1, Cy1)-(Cx1 + Cside, Cy1 + Cside), _RGBA32(50, 100, 100, 255), BF
' it decreases the Cside ranging between 100 and 160
Cside = Cside - 10
If Cside < 100 Then Cside = 100
ElseIf _MouseWheel > 0 Then
' it draws the background of camera
Line (Cx1, Cy1)-(Cx1 + Cside, Cy1 + Cside), _RGBA32(50, 100, 100, 255), BF
' it increases the Cside ranging between 100 and 160
Cside = Cside + 10
If Cside > 160 Then Cside = 160
End If
ElseIf Mmode = "Zoomer" Then
If _MouseWheel > 0 Then
If increasing < Mz Then increasing = increasing + 1
ElseIf _MouseWheel < 0 Then
If increasing > 1 Then increasing = increasing - 1
End If
End If
_PrintString (200, 60), "Zoom ratio:" + Str$((increasing)) + " "
' it takes area of camera from source Limage and puts it on screen window in camera image place at zoom state
Camera Ax1, Ay1, Ix1, Iy1, Cside, Cx1, Cy1, Limage, 0, increasing, Mz
End If
End If
Loop Until InKey$ <> ""
End
Function IntheRange (Min As Integer, Max As Integer, Test As Integer)
IntheRange = 0
If Min <= Test And Test <= Max Then IntheRange = -1
End Function
Sub AreaCamera (X As Integer, Y As Integer, Cside As Integer, Sx1 As Integer, Sy1 As Integer, Sx2 As Integer, Sy2 As Integer, Ax1 As Integer, Ay1 As Integer)
Ax1 = X - Int(Cside / 2)
If Ax1 < Sx1 Then
Ax1 = Sx1
ElseIf Ax1 + Cside > Sx2 Then
Ax1 = Sx2 - Cside
End If
Ay1 = Y - Int(Cside / 2)
If Ay1 < Sy1 Then
Ay1 = Sy1
ElseIf Ay1 + Cside > Sy2 Then
Ay1 = Sy2 - Cside
End If
End Sub
Sub Camera (AX As Integer, AY As Integer, Sx1 As Integer, Sy1 As Integer, Cside As Integer, Dx1 As Integer, Dy1 As Integer, Sh As Long, Dh As Long, Incr As Integer, Mz As Integer)
' it copies from source image to area of destination of camera image
_PutImage (Dx1, Dy1)-Step(Cside, Cside), Sh, Dh, ((AX - Sx1) + (1 * Incr), (AY - Sy1) + (1 * Incr))-Step(Cside - (Mz * (Incr - 1)), Cside - (Mz * (Incr - 1)))
End Sub
PostScriptum:
do you like my color IDE scheme?
RE: A little demo for camera and zoomer on image - Pete - 03-13-2025
+1... but I would suggest looking into using hardware acceleration for the mouse movement. It's too laggy as is. By keeping the original image on a screen and copying the window image, you can then use hardware acceleration to _putimage at the new coordinates. Now this app uses 36% CPU on my resource poor little laptop system. Looping apps without _limit, especially when hardware acceleration is involved, should have a system idle routine employed.
This reminded me of a time before hardware acceleration was available. I made a window that could be moved in a graphics gui app but even with my best efforts of optimization, I could not move the mouse, without experiencing lag, as quickly as I could in similar Windows applications.
Pete
PS I do like the color scheme. I have a similar one, as I like the yellow for remarks, but I don't do pink are any different color for numbers.
RE: A little demo for camera and zoomer on image - NakedApe - 03-13-2025
Very cool! The mouse isn't laggy for me, though the white window box does flicker a lot when you move it around. Nice work. And, yeh, I like your bold and brazen color scheme.
RE: A little demo for camera and zoomer on image - TempodiBasic - 03-15-2025
Thanks for feedback
here a better (I hope ) version
I add a _display for flickering of white square and the use of image with hardware acceleration
a screenshot
![[Image: Camera-and-zoomer-with-graphic-mode-33.jpg]](https://i.ibb.co/5WS4XSx1/Camera-and-zoomer-with-graphic-mode-33.jpg)
the code
Code: (Select All)
Rem the idea is to show a piece of image (camera) around the mouse pointer into another canvas using _putimage
Rem a canvas is for the first image and a second canvas is for pointer camera so we can play with _putimage
Rem joining cameraPointer and Zoomer stuff
Rem using hardware accelaration for a better performance on different hardwares
Rem using _display to avoid white square flickering on different hardwares
Dim Lscreen As Long, Limage As Long, LHardImg As Long
' it makes the original image object of the zoom
Limage = _NewImage(600, 300, 32)
_Dest Limage
Cls
For turn = 1 To 200
Line (1 + Int(Rnd * 600), 1 + Int(Rnd * 300))-(10 + Int(Rnd * 590), 10 + Int(Rnd * 290)), _RGBA32(Int(Rnd * 200), Int(Rnd * 200), Int(Rnd * 200), 255), B
Next turn
LHardImg = _CopyImage(Limage, 33)
_FreeImage Limage
'it makes the white square selector
Lscreen = _NewImage(100, 100, 32)
_Dest Lscreen
Cls , _RGBA32(0, 0, 0, 0)
Line (1, 1)-(99, 99), _RGBA32(255, 255, 255, 255), B
Limage = _CopyImage(Lscreen, 33)
_FreeImage Lscreen
' it makes the window's graphic
Lscreen = _NewImage(800, 600, 32)
Screen Lscreen
_Title "Camera moved by mouse pointer, mouse wheel modifies area camera (pointer Mode) / depth of zoom (zoom Mode)"
Dim As Integer Ix1, Iy1, Ix2, Iy2, Cx1, Cy1, Cside, Mz, Ax1, Ay1, increasing
Dim As String Mmode
Ix1 = 100: Iy1 = 90: Ix2 = 700: Iy2 = 390: Cx1 = 100: Cy1 = 440: Cside = 100: Mz = 10: Mmode = "Pointer"
Ax1 = 0: Ay1 = 0: increasing = 1
Cls , _RGBA32(50, 100, 100, 255)
_PrintString (20, 60), "Original image"
_PrintString (200, 60), "Zoom ratio:" + Str$((increasing)) + " "
_PutImage (Ix1, Iy1)-(Ix2, Iy2), LHardImg, 0
_PrintString (20, 410), "Image pointed"
_PutImage (Cx1, Cy1)-(Cx1 + Cside, Cy1 + Cside), Limage, 0
_PrintString (150, 410), "Move mouse on the picture, roll mouse wheel, left click toggle Mode"
_Display
_MouseMove Ix1, Iy1
Do
If _MouseInput Then
NMx = _MouseX
NMy = _MouseY
If IntheRange(Ix1, Ix2, NMx) And IntheRange(Iy1, Iy2, NMy) Then
AreaCamera NMx, NMy, Cside, Ix1, Iy1, Ix2, Iy2, Ax1, Ay1
' it shows the area of source selected as area of camera
'Line (Ax1, Ay1)-Step(Cside, Cside), _RGB32(238), B , LHardImg
_PutImage (Ix1, Iy1)-(Ix2, Iy2), LHardImg, 0
_PutImage (Ax1, Ay1)-Step(Cside, Cside), Limage, 0
_Display ' to avoid flickering in some PCs
If _MouseButton(1) Then
' it switches between modes Pointer / Zoomer
If Mmode = "Pointer" Then Mmode = "Zoomer" Else Mmode = "Pointer"
End If
If Mmode = "Pointer" Then
If _MouseWheel < 0 Then
' it draws the background of camera
Line (Cx1, Cy1)-(Cx1 + Cside, Cy1 + Cside), _RGBA32(50, 100, 100, 255), BF
' it decreases the Cside ranging between 100 and 160
Cside = Cside - 10
If Cside < 100 Then Cside = 100
ElseIf _MouseWheel > 0 Then
' it draws the background of camera
Line (Cx1, Cy1)-(Cx1 + Cside, Cy1 + Cside), _RGBA32(50, 100, 100, 255), BF
' it increases the Cside ranging between 100 and 160
Cside = Cside + 10
If Cside > 160 Then Cside = 160
End If
ElseIf Mmode = "Zoomer" Then
If _MouseWheel > 0 Then
If increasing < Mz Then increasing = increasing + 1
ElseIf _MouseWheel < 0 Then
If increasing > 1 Then increasing = increasing - 1
End If
End If
_PrintString (340, 60), "Side Camera:" + Str$(Cside) + " "
_PrintString (200, 60), "Zoom ratio:" + Str$((increasing)) + " "
' it takes area of camera from source Limage and puts it on screen window in camera image place at zoom state
Camera Ax1, Ay1, Ix1, Iy1, Cside, Cx1, Cy1, LHardImg, 0, increasing, Mz
End If
End If
Loop Until InKey$ <> ""
End
Function IntheRange (Min As Integer, Max As Integer, Test As Integer)
IntheRange = 0
If Min <= Test And Test <= Max Then IntheRange = -1
End Function
Sub AreaCamera (X As Integer, Y As Integer, Cside As Integer, Sx1 As Integer, Sy1 As Integer, Sx2 As Integer, Sy2 As Integer, Ax1 As Integer, Ay1 As Integer)
Ax1 = X - Int(Cside / 2)
If Ax1 < Sx1 Then
Ax1 = Sx1
ElseIf Ax1 + Cside > Sx2 Then
Ax1 = Sx2 - Cside
End If
Ay1 = Y - Int(Cside / 2)
If Ay1 < Sy1 Then
Ay1 = Sy1
ElseIf Ay1 + Cside > Sy2 Then
Ay1 = Sy2 - Cside
End If
End Sub
Sub Camera (AX As Integer, AY As Integer, Sx1 As Integer, Sy1 As Integer, Cside As Integer, Dx1 As Integer, Dy1 As Integer, Sh As Long, Dh As Long, Incr As Integer, Mz As Integer)
' it copies from source image to area of destination of camera image
_PutImage (Dx1, Dy1)-Step(Cside, Cside), Sh, Dh, ((AX - Sx1) + (1 * Incr), (AY - Sy1) + (1 * Incr))-Step(Cside - (Mz * (Incr - 1)), Cside - (Mz * (Incr - 1)))
End Sub
RE: A little demo for camera and zoomer on image - TempodiBasic - 03-16-2025
Hi friends
keep patience
I have thought that it is possible to make the square of area selected by mouse pointer by using OpenGl technology...
so this is the version of code in which the selected area by mouse uses OpenGl commands...
here a screenshot
![[Image: Pointer-Camera-with-Openg-Gl-square-area...ection.jpg]](https://i.ibb.co/2rNd5rn/Pointer-Camera-with-Openg-Gl-square-area-of-selection.jpg)
and here the code
Code: (Select All)
Rem the idea is to show a piece of image (camera) around the mouse pointer into another canvas using _putimage
Rem a canvas is for the first image and a second canvas is for pointer camera so we can play with _putimage
Rem joining cameraPointer and Zoomer stuff
Rem using hardware accelaration for a better performance on different hardwares
Rem using _display to avoid white square flickering on different hardwares
Rem using _Opengl to draw square area selected of the orginal image
Dim Lscreen As Long, Limage As Long, LHardImg As Long
Limage = _NewImage(600, 300, 32)
' make the original image object of the zoom
_Dest Limage
Cls , _RGBA32(0, 0, 0, 255)
For turn = 1 To 200
Line (1 + Int(Rnd * 600), 1 + Int(Rnd * 300))-(10 + Int(Rnd * 590), 10 + Int(Rnd * 290)), _RGBA32(Int(Rnd * 200), Int(Rnd * 200), Int(Rnd * 200), 255), B
Next turn
LHardImg = _CopyImage(Limage, 33) ' it makes a hardware copy of Limage
Lscreen = _NewImage(800, 600, 32)
Screen Lscreen
' it makes the window's graphic
_Title "Camera moved by mouse pointer, mouse wheel modifies area camera (pointer Mode) / depth of zoom (zoom Mode)"
Dim As Integer Ix1, Iy1, Ix2, Iy2, Cx1, Cy1, Cside, Mz, Ax1, Ay1, increasing, glGo
Dim As String Mmode
Ix1 = 100: Iy1 = 90: Ix2 = 700: Iy2 = 390: Cx1 = 100: Cy1 = 440: Cside = 100: Mz = 10: Mmode = "Pointer"
Ax1 = 0: Ay1 = 0: increasing = 1: glGo = 0
_DisplayOrder _Software , _Hardware , _GLRender
Cls , _RGBA32(50, 100, 100, 255)
_PrintString (20, 60), "Original image"
_PrintString (200, 60), "Zoom ratio:" + Str$((increasing)) + " "
_PrintString (20, 410), "Image pointed"
_PrintString (150, 410), "Move mouse on the picture, roll mouse wheel, left click toggle Mode"
_MouseMove Ix1 + 1, Iy1 + 1
Do
' it shows orginal image in hardware mode
_PutImage (Ix1, Iy1)-(Ix2, Iy2), LHardImg, 0
' it takes area of camera from source Limage and puts it on screen window in camera image place at zoom state
Camera Ax1, Ay1, Ix1, Iy1, Cside, Cx1, Cy1, LHardImg, 0, increasing, Mz
_PrintString (200, 60), "Zoom ratio:" + Str$((increasing)) + " "
_Display ' to avoid flickering in some PCs
If _MouseInput Then
NMx = _MouseX
NMy = _MouseY
If IntheRange(Ix1, Ix2, NMx) And IntheRange(Iy1, Iy2, NMy) Then
AreaCamera NMx, NMy, Cside, Ix1, Iy1, Ix2, Iy2, Ax1, Ay1
If glGo = 1 Then glGo = 2
If _MouseButton(1) Then
' it switches between modes Pointer / Zoomer
If Mmode = "Pointer" Then Mmode = "Zoomer" Else Mmode = "Pointer"
End If
If Mmode = "Pointer" Then
If _MouseWheel < 0 Then
' it draws the background of camera
Line (Cx1, Cy1)-(Cx1 + Cside, Cy1 + Cside), _RGBA32(50, 100, 100, 255), BF
' it decreases the Cside ranging between 100 and 160
Cside = Cside - 10
If Cside < 100 Then Cside = 100
ElseIf _MouseWheel > 0 Then
' it draws the background of camera
Line (Cx1, Cy1)-(Cx1 + Cside, Cy1 + Cside), _RGBA32(50, 100, 100, 255), BF
' it increases the Cside ranging between 100 and 160
Cside = Cside + 10
If Cside > 160 Then Cside = 160
End If
ElseIf Mmode = "Zoomer" Then
If _MouseWheel > 0 Then
If increasing < Mz Then increasing = increasing + 1
ElseIf _MouseWheel < 0 Then
If increasing > 1 Then increasing = increasing - 1
End If
End If
End If
End If
Loop Until InKey$ <> ""
End
Function IntheRange (Min As Integer, Max As Integer, Test As Integer)
IntheRange = 0
If Min <= Test And Test <= Max Then IntheRange = -1
End Function
Sub AreaCamera (X As Integer, Y As Integer, Cside As Integer, Sx1 As Integer, Sy1 As Integer, Sx2 As Integer, Sy2 As Integer, Ax1 As Integer, Ay1 As Integer)
Ax1 = X - Int(Cside / 2)
If Ax1 < Sx1 Then
Ax1 = Sx1
ElseIf Ax1 + Cside > Sx2 Then
Ax1 = Sx2 - Cside
End If
Ay1 = Y - Int(Cside / 2)
If Ay1 < Sy1 Then
Ay1 = Sy1
ElseIf Ay1 + Cside > Sy2 Then
Ay1 = Sy2 - Cside
End If
End Sub
Sub Camera (AX As Integer, AY As Integer, Sx1 As Integer, Sy1 As Integer, Cside As Integer, Dx1 As Integer, Dy1 As Integer, Sh As Long, Dh As Long, Incr As Integer, Mz As Integer)
' it copies from source image to area of destination of camera image
_PutImage (Dx1, Dy1)-Step(Cside, Cside), Sh, Dh, ((AX - Sx1) + (1 * Incr), (AY - Sy1) + (1 * Incr))-Step(Cside - (Mz * (Incr - 1)), Cside - (Mz * (Incr - 1)))
End Sub
Sub _GL ()
Shared Ax1 As Integer, Ay1 As Integer, Cside As Integer, glGo As Integer
' initialization control
If glGo = 0 Then
' initialization for OpenGl
_glViewport 0, 0, _Width, _Height ' the new cohordinates for viewport of GlOperations
_glClearColor 0, 0, 0, 0 ' the cancel color is transparent 100%
glGo = 1
Exit Sub
ElseIf glGo = 1 Then
Exit Sub 'it exits until data are not avaiable
End If
_glMatrixMode _GL_MODELVIEW ' it uses the actual view matrix
_glTranslatef -1, 1, 0 ' it multiplies the current matrix with this scale's factors x y z
_glScalef (1 / (_Width / 2)), (-1 / (_Height / 2)), 1 ' it transforms the current matrix using the above definied matrix
_glColor4ub 255, 255, 255, 255 ' it sets color of graphic to do using 4 bytes for a RGBA setting
_glBegin _GL_LINE_LOOP ' it starts the OpenGl primitive graphic to execute
_glVertex2i Ax1, Ay1 ' it defines the 4 vertexes of the square
_glVertex2i (Ax1 + Cside), Ay1
_glVertex2i (Ax1 + Cside), (Ay1 + Cside)
_glVertex2i Ax1, (Ay1 + Cside)
_glEnd ' it ends the OpenGl primitive graphic
_glFlush ' it forcces to draw GlGraphic
End Sub
Thanks for feedbacks