[TURORIAL] zoom-function for your personal gadgets

Share your advanced PureBasic knowledge/code with the community.
User avatar
microdevweb
Enthusiast
Enthusiast
Posts: 179
Joined: Fri Jun 13, 2014 9:38 am
Location: Belgique

[TURORIAL] zoom-function for your personal gadgets

Post by microdevweb »

Hi all,

Sometime we need to a zoom-function for our personal gadgets,

So this is a code for making this.

Note: move the mouse thumbwheel for change zoom factor

Image

Code: Select all

; AUTHOR  : MicrodevWeb
; DATE    : 2017-09-11
; NAME    : make zoom function for your personal canvas-gadgets
;***************************************************************
Global Zoom_factor.f=1 
Structure sButton
  ID.l
  x.l
  y.l
  w.l
  h.l
  name.s
  color.l
EndStructure
Global Dim myButtons.sButton(6)

#Main_form=0
#Main_canvas=0

Procedure Create_buttons()
  Protected i,x=50
  ; I make here some buttons
  For i=0 To 5
    With myButtons(i)
      \name="Button "+Str(i)
      \w=50
      \h=50
      \x=x
      \y=50
      \color=RGBA(Random(255,0), Random(255,0), Random(255,0), 255)
    EndWith
    x+60
  Next
EndProcedure

Procedure Draw()
  Protected i=0
  ; I draw my buttons
  StartVectorDrawing(CanvasVectorOutput(#Main_canvas,#PB_Unit_Pixel))
  ; this manage the zooming
  ScaleCoordinates(Zoom_factor,Zoom_factor,#PB_Coordinate_User)
  VectorSourceColor($FFFFFFFF)
  FillVectorOutput()
  For i=0 To 5
    With myButtons(i)
      AddPathBox(\x,\y,\w,\h)
      VectorSourceColor(\color)
      FillPath()
    EndWith
  Next
  StopVectorDrawing()
EndProcedure

Procedure myEvent()
  Protected Mx,My,x,y
  ; we need to convert the coordinates
  StartVectorDrawing(CanvasVectorOutput(#Main_canvas,#PB_Unit_Pixel))
  ScaleCoordinates(Zoom_factor,Zoom_factor,#PB_Coordinate_User)
  x=GetGadgetAttribute(#Main_canvas,#PB_Canvas_MouseX)
  y=GetGadgetAttribute(#Main_canvas,#PB_Canvas_MouseY)
  Mx=ConvertCoordinateX(x,0,#PB_Coordinate_Output,#PB_Coordinate_User)
  My=ConvertCoordinateY(0,y,#PB_Coordinate_Output,#PB_Coordinate_User)
  StopVectorDrawing()
  Select EventType()
    Case #PB_EventType_MouseMove
      ; here i look for which button is overflew
      For i=0 To 5
        With myButtons(i)
          If Mx>=\x And Mx<=(\x+\w) And 
             My>=\y And My<=(\y+\h)
            Debug \name
            SetGadgetAttribute(#Main_canvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
            ProcedureReturn 
          EndIf
        EndWith
      Next
      Debug "NONE"
      SetGadgetAttribute(#Main_canvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
    Case #PB_EventType_MouseWheel
      ; gestion du facteur de zoom
      Select GetGadgetAttribute(#Main_canvas,#PB_Canvas_WheelDelta)
        Case -1
          If Zoom_factor>0.1 ;10%
            Zoom_factor-0.1
          EndIf
        Case 1
          If Zoom_factor<4 ;400%
            Zoom_factor+0.1
          EndIf
      EndSelect
      Draw()
    Case #PB_EventType_MouseEnter
      SetActiveGadget(#Main_canvas)
  EndSelect
EndProcedure

Create_buttons()

OpenWindow(#Main_form,0,0,460,150,"teste",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CanvasGadget(#Main_canvas,0,0,460,150,#PB_Canvas_Keyboard)
Draw()
BindGadgetEvent(#Main_canvas,@myEvent())

Repeat
  WaitWindowEvent()
Until Event()=#PB_Event_CloseWindow
Last edited by microdevweb on Mon Sep 11, 2017 1:18 pm, edited 1 time in total.
Use Pb 5.73 lst and Windows 10

my mother-language isn't english, in advance excuse my mistakes.
User avatar
microdevweb
Enthusiast
Enthusiast
Posts: 179
Joined: Fri Jun 13, 2014 9:38 am
Location: Belgique

Re: [TURORIAL] zoom-function for your personal gadgets

Post by microdevweb »

Hi all,

I have modified a part of my code for users of x86.
Use Pb 5.73 lst and Windows 10

my mother-language isn't english, in advance excuse my mistakes.
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: [TURORIAL] zoom-function for your personal gadgets

Post by RSBasic »

Thank you for sharing. :)
Image
Image
Post Reply