```js //test.frm Private Sub Form_Load() Dim N As Integer Dim I As Integer
’ Dummy values With MSFlexGrid1 .Rows = 100 .Cols = 5 For N = .FixedRows To .Rows - 1 .TextMatrix(N, 0) = “Row “ & N Next N End With
With MSFlexGrid2 .Rows = 100 .Cols = 5 For N = .FixedRows To .Rows - 1 .TextMatrix(N, 0) = “Row “ & N Next N End With
For N = 0 To 20 Combo1.AddItem “Test “ & N List1.AddItem “Test “ & N Next N
’ Hook Form Call WheelHook(Me.hWnd)
’ Hook Controls to be ignored Call WheelHook(Combo1.hWnd) Call WheelHook(List1.hWnd) Call WheelHook(Text1.hWnd)
Form2.Show End Sub
Private Sub Form_Unload(Cancel As Integer) Call WheelUnHook(Me.hWnd) Call WheelUnHook(Combo1.hWnd) Call WheelUnHook(Text1.hWnd) Unload Form2 End Sub
’ Here you can add scrolling support to controls that don’t normally respond. ‘ This Sub could always be moved to a module to make scrollwheel behaviour ‘ generic across forms. ‘ =========================================================================== Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long) Dim ctl As Control Dim bHandled As Boolean Dim bOver As Boolean
For Each ctl In Controls ‘ Is the mouse over the control On Error Resume Next bOver = (ctl.Visible And IsOver(ctl.hWnd, Xpos, Ypos)) On Error GoTo 0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
If bOver Then
' If so, respond accordingly
bHandled = True
Select Case True
Case TypeOf ctl Is MSFlexGrid
FlexGridScroll ctl, MouseKeys, Rotation, Xpos, Ypos
Case TypeOf ctl Is PictureBox
PictureBoxZoom ctl, MouseKeys, Rotation, Xpos, Ypos
Case TypeOf ctl Is ListBox, TypeOf ctl Is TextBox, TypeOf ctl Is ComboBox
' These controls already handle the mousewheel themselves, so allow them to:
If ctl.Enabled Then ctl.SetFocus
Case Else
bHandled = False
End Select
If bHandled Then Exit Sub
End If
bOver = False Next ctl
’ Scroll was not handled by any controls, so treat as a general message send to the form Me.Caption = “Form Scroll “ & IIf(Rotation < 0,=”” “down”,=”” “up”)=”” end=”” sub=”” ="" ="" =""js=”” module1.bas=”” ‘=”” store=”” wndprocs=”” private=”” declare=”” function=”” getprop=”” lib=”” “user32.dll”=”” alias=”” “getpropa”=”” (=”” _=”” byval=”” hwnd=”” as=”” long,=”” _=”” byval=”” lpstring=”” as=”” string)=”” as=”” long=”” private=”” declare=”” function=”” setprop=”” lib=”” “user32.dll”=”” alias=”” “setpropa”=”” (=”” _=”” byval=”” hwnd=”” as=”” long,=”” _=”” byval=”” lpstring=”” as=”” string,=”” _=”” byval=”” hdata=”” as=”” long)=”” as=”” long=”” private=”” declare=”” function=”” removeprop=”” lib=”” “user32.dll”=”” alias=”” “removepropa”=”” (=”” _=”” byval=”” hwnd=”” as=”” long,=”” _=”” byval=”” lpstring=”” as=”” string)=”” as=”” long=”” ‘=”” hooking=”” private=”” declare=”” function=”” callwindowproc=”” lib=”” “user32.dll”=”” alias=”” “callwindowproca”=”” (=”” _=”” byval=”” lpprevwndfunc=”” as=”” long,=”” _=”” byval=”” hwnd=”” as=”” long,=”” _=”” byval=”” msg=”” as=”” long,=”” _=”” byval=”” wparam=”” as=”” long,=”” _=”” byval=”” lparam=”” as=”” long)=”” as=”” long=”” private=”” declare=”” function=”” setwindowlong=”” lib=”” “user32.dll”=”” alias=”” “setwindowlonga”=”” (=”” _=”” byval=”” hwnd=”” as=”” long,=”” _=”” byval=”” nindex=”” as=”” long,=”” _=”” byval=”” dwnewlong=”” as=”” long)=”” as=”” long=”” private=”” declare=”” function=”” sendmessage=”” lib=”” “user32.dll”=”” alias=”” “sendmessagea”=”” (=”” _=”” byval=”” hwnd=”” as=”” long,=”” _=”” byval=”” msg=”” as=”” long,=”” _=”” wparam=”” as=”” any,=”” _=”” lparam=”” as=”” any)=”” as=”” long=”” ‘=”” position=”” checking=”” private=”” declare=”” function=”” getwindowrect=”” lib=”” “user32”=”” (=”” _=”” byval=”” hwnd=”” as=”” long,=”” _=”” lprect=”” as=”” rect)=”” as=”” long=”” private=”” declare=”” function=”” getparent=”” lib=”” “user32”=”” (=”” _=”” byval=”” hwnd=”” as=”” long)=”” as=”” long=”” private=”” const=”” gwl_wndproc=”-4” private=”” const=”” wm_mousewheel=”&H20A” private=”” const=”” cb_getdroppedstate=”&H157” private=”” type=”” rect=”” left=”” as=”” long=”” top=”” as=”” long=”” right=”” as=”” long=”” bottom=”” as=”” long=”” end=”” type=”” ‘=”” check=”” messages=”” ‘=”===============================================” private=”” function=”” windowproc(byval=”” lwnd=”” as=”” long,=”” byval=”” lmsg=”” as=”” long,=”” byval=”” wparam=”” as=”” long,=”” byval=”” lparam=”” as=”” long)=”” as=”” long=”” dim=”” mousekeys=”” as=”” long=”” dim=”” rotation=”” as=”” long=”” dim=”” xpos=”” as=”” long=”” dim=”” ypos=”” as=”” long=”” dim=”” ffrm=”” as=”” form=”” select=”” case=”” lmsg=”” case=”” wm_mousewheel=”” mousekeys=”wParam” and=”” 65535=”” rotation=”wParam” 65536=”” xpos=”lParam” and=”” 65535=”” ypos=”lParam” 65536=”” set=”” ffrm=”GetForm(Lwnd)” if=”” ffrm=”” is=”” nothing=”” then=”” ‘=”” it’s=”” not=”” a=”” form=”” if=”” not=”” isover(lwnd,=”” xpos,=”” ypos)=”” and=”” isover(getparent(lwnd),=”” xpos,=”” ypos)=”” then=”” ‘=”” it’s=”” not=”” over=”” the=”” control=”” and=”” is=”” over=”” the=”” form,=”” ‘=”” so=”” fire=”” mousewheel=”” on=”” form=”” (if=”” it’s=”” not=”” a=”” dropped=”” down=”” combo)=”” if=”” sendmessage(lwnd,=”” cb_getdroppedstate,=”” 0&,=”” 0&)=””><> 1 Then GetForm(GetParent(Lwnd)).MouseWheel MouseKeys, Rotation, Xpos, Ypos Exit Function ‘ Discard scroll message to control End If End If Else ‘ it’s a form so fire mousewheel If IsOver(fFrm.hWnd, Xpos, Ypos) Then fFrm.MouseWheel MouseKeys, Rotation, Xpos, Ypos End If End Select
WindowProc = CallWindowProc(GetProp(Lwnd, “PrevWndProc”), Lwnd, Lmsg, wParam, lParam) End Function
’ Hook / UnHook ‘ ================================================ Public Sub WheelHook(ByVal hWnd As Long) On Error Resume Next SetProp hWnd, “PrevWndProc”, SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc) End Sub
Public Sub WheelUnHook(ByVal hWnd As Long) On Error Resume Next SetWindowLong hWnd, GWL_WNDPROC, GetProp(hWnd, “PrevWndProc”) RemoveProp hWnd, “PrevWndProc” End Sub
’ Window Checks ‘ ================================================ Public Function IsOver(ByVal hWnd As Long, ByVal lX As Long, ByVal lY As Long) As Boolean Dim rectCtl As RECT GetWindowRect hWnd, rectCtl With rectCtl IsOver = (lX >= .Left And lX <= .right=”” and=”” ly=””>= .Top And lY <= .bottom)=”” end=”” with=”” end=”” function=”” private=”” function=”” getform(byval=”” hwnd=”” as=”” long)=”” as=”” form=”” for=”” each=”” getform=”” in=”” forms=”” if=”” getform.hwnd=”hWnd” then=”” exit=”” function=”” next=”” getform=”” set=”” getform=”Nothing” end=”” function=”” ‘=”” control=”” specific=”” behaviour=”” ‘=”===============================================” public=”” sub=”” flexgridscroll(byref=”” fg=”” as=”” msflexgrid,=”” byval=”” mousekeys=”” as=”” long,=”” byval=”” rotation=”” as=”” long,=”” byval=”” xpos=”” as=”” long,=”” byval=”” ypos=”” as=”” long)=”” dim=”” newvalue=”” as=”” long=”” dim=”” lstep=”” as=”” single=”” on=”” error=”” resume=”” next=”” with=”” fg=”” lstep=”.Height” .rowheight(0)=”” lstep=”Int(Lstep)” if=”” .rows=””></=>< lstep=”” then=”” exit=”” sub=”” do=”” while=”” not=”” (.rowisvisible(.toprow=”” +=”” lstep))=”” lstep=”Lstep” -=”” 1=”” loop=”” if=”” rotation=””> 0 Then NewValue = .TopRow - Lstep If NewValue < 1=”” then=”” newvalue=”1” end=”” if=”” else=”” newvalue=”.TopRow” +=”” lstep=”” if=”” newvalue=””> .Rows - 1 Then NewValue = .Rows - 1 End If End If .TopRow = NewValue End With End Sub
Public Sub PictureBoxZoom(ByRef picBox As PictureBox, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long) picBox.Cls picBox.Print “MouseWheel “ & IIf(Rotation < 0, “down”, “up”) end sub
``` 0,=”” “down”,=”” “up”)=”” end=”” sub=””></ 0, “down”, “up”) end sub
```></=>
origin - http://www.pipiscrew.com/?p=3362 vb6-mousewheel-support