|
You can accidentally use the mousewheel to scroll to the next record in an unbound form. And that can cause Access to
hang-up, with an unbound form. It just flickers and won't allow further access to Access.
I had this little popup box that was an alternative to editing text in a memo field. And every now and then I'd forget
about the mousewheel problem and just habitually scroll as if editing in U-edit or something. I'd have to
ctrl-alt-delete to get rid of Access, and try again.
Then I came across this code, below. I don't know where it came from. It works well enough. I see other solutions that
require an external dll. And this doesn't. But if you don't 'unhook', or rather try to double-hook, it can make your
Access disappear real fast (just closes it right up). I just wonder who came up with this, if anyone knows:
basMouseWheel :
Public Const GWL_WNDPROC = -4
Public boolHooked As Boolean
Public lpPrevWndProc As Long
Public gHW As Long
Public Sub Hook()
If Not boolHooked Then lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddrOf("WindowProc"))
boolHooked = True
End Sub
Public Sub Unhook()
Dim lngDum As Long
lngDum = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
boolHooked = False
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = GetMouseWheelMsg Then
WindowProc = 0
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End If
End Function
Public Function AddrOf(strFuncName As String) As Long
Dim hProject As Long, lngResult As Long, lpfn As Long
Dim strID As String, strFuncNameUnicode As String
Const NO_ERROR = 0
strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
Call GetCurrentVbaProject(hProject)
If hProject <> 0 Then
lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
If lngResult = NO_ERROR Then
lngResult = GetAddrByID(hProject, strID, lpfn)
If lngResult = NO_ERROR Then AddrOf = lpfn
End If
End If
End Function
Public Function GetMouseWheelMsg() As Long
' 522 for 98 and 2K, otherwise use: RegisterWindowMessageA("MSWHEEL_ROLLMSG")
GetMouseWheelMsg = 522
End Function
basWinAPI :
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function RegisterWindowMessageA Lib "user32" _
(ByVal lpString As String)
Public Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" _
(hProject As Long) As Long
Public Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" _
(ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionId As String) As Long
Public Declare Function GetAddrByID Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, _
ByVal strFunctionId As String, _
ByRef lpfn As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
And in the class module of the form calling this:
Public Sub Form_Load()
gHW = Me.hwnd
Hook
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub
| 
