Detecting Mouse Wheel Scrolling

Date: 02-16-2022

Return to Index

 
'Many programs need to respond to scrolling the mousewheel in an edit control.
'Monitoring the WM_MouseWheel message in a the subclass procedure of the
'edit control does the trick.
 
'Primary Code:
'Put this code in the window procedure of the subclassed edit control.
      Case %WM_MouseWheel
         Select Case Hi(Integer,wParam)    'note the use of Integer
           Case > 0
               Dialog Set Text hDlg, "up  " + Str$(Hi(Integer,wParam))
           Case < 0
               Dialog Set Text hDlg, "down  " + Str$(Hi(Integer,wParam))
         End Select
 
'Compilable Example:  (Jose Includes)
'In this example, subclassing of a RichEdit control is used to demonstrate
'how to respond to the WM_MouseWheel message.
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc" 
#Include "RichEdit.inc"
#Include "CommCtrl.inc"
Global hDlg as DWord, hRichEdit as DWord, OldProc&
 
Function PBMain() As Long
   Local style&, buf$
   buf$ =  Repeat$(20,"This is sample" + $CrLf + "text for the" + $CrLf + "edit control." + $crlf)
   style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
   Dialog New Pixels, 0, "Test Code",300,300,400,200, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Push", 30,10,140,20
   LoadLibrary("riched32.dll") : InitCommonControls
   Control Add "RichEdit", hDlg, 500, buf$,20,40,360,150, style&
   Control Handle hDlg, 500 To hRichEdit
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_InitDialog
         OldProc& = SetWindowLong(GetDlgItem(hDlg, 500), %GWL_WndProc, CodePTR(NewProc))  'subclass
      Case %WM_Destroy
         SetWindowLong hRichEdit, %GWL_WNDPROC, OldProc&   'un-subclass
   End Select
End Function
 
Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case Msg
      Case %WM_MouseWheel
         Select Case Hi(Integer,wParam)    'note the use of Integer
            Case > 0
               Dialog Set Text hDlg, "up  " + Str$(Hi(Integer,wParam))
            Case < 0
               Dialog Set Text hDlg, "down  " + Str$(Hi(Integer,wParam))
         End Select
   End Select
   Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function
 
'gbs_00411
'Date: 03-10-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm