A little demo for camera and zoomer on image

[TempodiBasic]

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

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

Enjoy the power of QB64pe!


PostScriptum:
do you like my color IDE scheme?