Windows MouseWheel help

Windows specific forum
User avatar
Samuel
Enthusiast
Enthusiast
Posts: 756
Joined: Sun Jul 29, 2012 10:33 pm
Location: United States

Windows MouseWheel help

Post by Samuel »

I've got this code for windows mouse commands. When I click on one of the tree gadget items the mouse wheel will no longer work.
The rest of the mouse commands still function properly though. Which has me kinda confused.
So, does anyone now what I'm missing or doing wrong?

Code: Select all

Procedure wc (hWnd, uMsg, wParam, lParam)   
    Select uMsg
    Case #WM_LBUTTONDOWN:Debug "Left Button Down"
    Case #WM_LBUTTONUP:Debug "Left Button Up"
    Case #WM_LBUTTONDBLCLK:Debug "Left Button Double Click"
    Case #WM_RBUTTONDOWN:Debug "Right Button Down"
    Case #WM_RBUTTONUP:Debug "Right Button Up"
    Case #WM_RBUTTONDBLCLK:Debug "Right Button Double Click"
    Case #WM_MBUTTONDOWN:Debug "Middle Button Down"
    Case #WM_MBUTTONUP:Debug "Middle Button Up"
    Case #WM_MBUTTONDBLCLK:Debug "Middle Button Double Click"
    Case #WM_MOUSEWHEEL
      If wparam > 0
        Debug "MouseWheel Forward"
      ElseIf wparam < 0
        Debug "MouseWheel Backward"
      EndIf
    EndSelect     
    ProcedureReturn #PB_ProcessPureBasicEvents
  EndProcedure
  
DesktopW=800
DesktopH=600

    
If OpenWindow(0, 0, 0, DesktopW, DesktopH, "Test",#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)

  SetWindowCallback(@wc(),0)

    TreeGadget(0, 0, 0, 150, 150)
    SetGadgetColor(0, #PB_Gadget_FrontColor, RGB(255,255,255))
    SetGadgetColor(0, #PB_Gadget_BackColor, RGB(50,50,50))
    SetGadgetColor(0, #PB_Gadget_LineColor, RGB(255,255,255))
    
        AddGadgetItem (0, -1, "Tree", 0, 0)
        AddGadgetItem (0, -1, "Branch 1", 0, 1)
        AddGadgetItem(0, -1, "Sub-Branch 1", 0, 2)
        AddGadgetItem (0, -1, "Branch 2", 0, 1)
        AddGadgetItem (0, -1, "Branch 3", 0, 1)


Repeat
  Event=WaitWindowEvent()   
  
  
Until Event = #PB_Event_CloseWindow

EndIf
End
User avatar
falsam
Enthusiast
Enthusiast
Posts: 632
Joined: Wed Sep 21, 2011 9:11 am
Location: France
Contact:

Re: Windows MouseWheel help

Post by falsam »

Use this code

Code: Select all

Procedure.w MouseWheelDelta()
  wz.w = ((EventwParam()>>16)&$FFFF)
  ProcedureReturn -(wz/100)
EndProcedure
  
DesktopW=800
DesktopH=600
    
If OpenWindow(0, 0, 0, DesktopW, DesktopH, "Test",#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
  TreeGadget(0, 0, 0, 150, 150)
  SetGadgetColor(0, #PB_Gadget_FrontColor, RGB(255,255,255))
  SetGadgetColor(0, #PB_Gadget_BackColor, RGB(50,50,50))
  SetGadgetColor(0, #PB_Gadget_LineColor, RGB(255,255,255))
    
  AddGadgetItem (0, -1, "Tree", 0, 0)
  AddGadgetItem (0, -1, "Branch 1", 0, 1)
  AddGadgetItem(0, -1, "Sub-Branch 1", 0, 2)
  AddGadgetItem (0, -1, "Branch 2", 0, 1)
  AddGadgetItem (0, -1, "Branch 3", 0, 1)

  Repeat
    Event  = WaitWindowEvent()  
    GEvent = EventGadget()
    
    Select Event
      Case #WM_MOUSEWHEEL      
        Item=Item+(MouseWheelDelta())
        Debug item
        
        If item >=0 And item < CountGadgetItems(0)
          SetGadgetState(0, Item)
          SetActiveGadget(0)
        Else
          Item = GetGadgetState(0)
        EndIf
               
      Case #WM_LBUTTONDOWN:Debug "Left Button Down"  
      Case #WM_LBUTTONUP:Debug "Left Button Up"
      Case #WM_LBUTTONDBLCLK:Debug "Left Button Double Click"
      Case #WM_RBUTTONDOWN:Debug "Right Button Down"
      Case #WM_RBUTTONUP:Debug "Right Button Up"
      Case #WM_RBUTTONDBLCLK:Debug "Right Button Double Click"
      Case #WM_MBUTTONDOWN:Debug "Middle Button Down"
      Case #WM_MBUTTONUP:Debug "Middle Button Up"
      Case #WM_MBUTTONDBLCLK:Debug "Middle Button Double Click"
        
      Case #PB_Event_Gadget
        Select GEvent
          Case 0
            Item = GetGadgetState(0)
            
        EndSelect
        
    EndSelect
  
  Until Event = #PB_Event_CloseWindow  
EndIf

➽ Windows 11 64-bit - PB 6.21 x64 - AMD Ryzen 7 - NVIDIA GeForce GTX 1650 Ti

Sorry for my bad english and the Dunning–Kruger effect 🤪
User avatar
Samuel
Enthusiast
Enthusiast
Posts: 756
Joined: Sun Jul 29, 2012 10:33 pm
Location: United States

Re: Windows MouseWheel help

Post by Samuel »

Thank you falsam,

I tried the code and it works fine. :D
Post Reply