PureBasic Forums - English

Code: Select all

Enumeration
  #windows
  #canvas
  #TextGadget1
  #TextGadget2
EndEnumeration
Global scale.d

Procedure drawing(zoom.d)
  
  StartDrawing(CanvasOutput(#canvas))
  Box(0,0,600,580,#White)
  Box(200 - zoom, 200 - zoom, 200 + zoom * 2, 180 + zoom * 2, RGB(0,200,200))
  StopDrawing()
  
EndProcedure 

If OpenWindow(#Windows, 0, 0, 620, 620, " Zoom Box X Y ", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  CanvasGadget(#Canvas, 10, 30, 600, 580, #PB_Canvas_Keyboard)
  TextGadget(#TextGadget1, 10,  5, 120, 20, "")
  TextGadget(#TextGadget2, 140,  5, 120, 20, "")
  
  SetActiveGadget(#Canvas)
  
  StartDrawing(CanvasOutput(#canvas))
  Box(200,200,200,180, RGB(0,200,200))
  StopDrawing()
 
  Repeat
    
    Event = WaitWindowEvent(20)
    
    SetGadgetText(#TextGadget1, "X_DeltaScreen : " + Str(- 1000 + DesktopMouseX()*2))  ;x - 1000 to resolutionX * 2
    SetGadgetText(#TextGadget2, "Y_DeltaScreen : " + Str(- 1000 + DesktopMouseY()*2))  ;y - 1000 to resolutionY * 2
    
    If Event = #PB_Event_Gadget
      If EventType() = #PB_EventType_MouseLeave | #PB_EventType_MouseMove
        SetActiveGadget(#Canvas)
      EndIf
      
      Select EventType()
        Case #PB_EventType_MouseWheel
          wheel = GetGadgetAttribute(#Canvas, #PB_Canvas_WheelDelta)
          If wheel > 0
            scale = scale + 5
            drawing(scale)
          ElseIf wheel = < 0
            scale = scale - 5
            drawing(scale)
          EndIf
      EndSelect
      
    EndIf
  Until Event = #PB_Event_CloseWindow
EndIf