[TUTO] zoom pour canvas

Informations pour bien débuter en PureBasic
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

[TUTO] zoom pour canvas

Message par microdevweb »

Bonjour à tous,

il peut s'avérer utile d'avoir une option zoom pour nos gadgets personnels. Voici une façon de le faire.

Remarque: déplacez la molette de la souris pour agrandir ou rétrécir

Image

Code : Tout sélectionner

; AUTHOR  : MicrodevWeb
; DATE    : 2017-09-11
; NAME    : make zoom function for your personal canvas-gadgets
;***************************************************************
Global Zoom_factor.f=1 ; facteur de zomm
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
  ; je crée ici quelques boutons
  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
  ; je dessine ici les boutons
  StartVectorDrawing(CanvasVectorOutput(#Main_canvas,#PB_Unit_Pixel))
  ; ceci va gèrer le zomm
  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
  ; on vas changer les coordonnées pour que cela fonctionne
  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
      ; ici je regarde sur quel bouton je suis
      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
Dernière modification par microdevweb le lun. 11/sept./2017 13:14, modifié 3 fois.
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: [TUTO zoom pour canvas

Message par Kwai chang caine »

Bonjour MicroDevWeb
Merci du partage 8)

J'ai une erreur à la ligne

Code : Tout sélectionner

 \color=Random($FFFFFF00,$FF0000FF)
dans la procedure Create_buttons()
Random min ne peut être négatif :|
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: [TUTO zoom pour canvas

Message par microdevweb »

Bonjour Kwai chang caine,

J'ai fait un petite modif, cela ne devrait plus posé de problème en x86
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: [TUTO] zoom pour canvas

Message par Kwai chang caine »

Merci MicroDevWeb 8)
Ca marche nickel maintenant :D
Je sais pas si c'est l'effet voulu, mais le zoom ne marche que si je clique une fois sur les carrés
Et c'est toute l'image qui zoome, du coup les carrés disparaissent en bas de la fenetre, puisque l'espace blanc du haut grandit aussi

Autrement top cool !!!
Encore merci du partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
François
Messages : 26
Inscription : mar. 14/juin/2016 12:31

Re: [TUTO] zoom pour canvas

Message par François »

Bonjour,

Très bien ce zoom.

Effectivement, il faut cliquer dans la fenêtre pour que le zoom fonctionne. Peut-être faut-il mettre le focus sur le Canvas ?

En tout cas, merci pour le partage.
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: [TUTO] zoom pour canvas

Message par microdevweb »

@Kwai chang caine,@François,

J'ai modifié le code de sorte que le canvas prenne le focus au survol de la souris

Code : Tout sélectionner

 Case #PB_EventType_MouseEnter
      SetActiveGadget(#Main_canvas)
:roll: En temps normal je place tjr cette option
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Répondre