Hi to everyone. I have a form with an MSFlexGrid. I can't get my mouse wheel scroll in the grid. I use a code from VB6 but it doesn't work. I am submitting the code below:
Code In Module:
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
Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim MyForm As UserForm
Dim MyGrid As MSFlexGrid
Private hControl As Long
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
If Lmsg = WM_MOUSEWHEEL Then
MouseKeys = Wparam And 65535
Rotation = Wparam / 65536
Xpos = Lparam And 65535
Ypos = Lparam / 65536
MouseWheel MouseKeys, Rotation, Xpos, Ypos, MyGrid
End If
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
End Function
Public Sub WheelHook(PassedForm As UserForm, PassedFlexGrid As MSFlexGrid)
On Error Resume Next
Set MyForm = PassedForm
LocalHwnd = PassedForm.hWnd
Set MyGrid = PassedFlexGrid
LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub WheelUnHook()
Dim WorkFlag As Long
On Error Resume Next
WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
Set MyForm = Nothing
End Sub
Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long, MyGrid As MSFlexGrid)
Dim NewValue As Long
Dim Lstep As Single
On Error Resume Next
With MyGrid
Lstep = .Height / .RowHeight(0)
Lstep = Int(Lstep)
If Lstep < 10 Then
Lstep = 10
End If
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
Code In The Form:
Private Sub msgr_01_Click()
WheelUnHook
WheelHook msgr_01
End Sub
Am using Autocad 2011x64 and Visual Basic 6.5. I believe the code needs an upgrade to work in 64bit. Any ideas or suggestions?
Thanks in advance.