Fare tekerleği - MouseWhell On/Off

Kod:
Option Compare Database



Option Explicit



Private Declare Function LoadLibrary Lib "kernel32" _

Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long



Private Declare Function FreeLibrary Lib "kernel32" _

(ByVal hLibModule As Long) As Long



Private Declare Function StopMouseWheel Lib "MouseHook" _

(ByVal hWnd As Long, ByVal AccessThreadID As Long, Optional ByVal blIsGlobal As Boolean = False) As Boolean



Private Declare Function StartMouseWheel Lib "MouseHook" _

(ByVal hWnd As Long) As Boolean



Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long



Private hLib As Long





Public Function MouseWheelON() As Boolean

MouseWheelON = StartMouseWheel(Application.hWndAccessApp)

If hLib <> 0 Then

    hLib = FreeLibrary(hLib)

End If

End Function



Public Function MouseWheelOFF(Optional GlobalHook As Boolean = False) As Boolean

Dim s As String

Dim blRet As Boolean

Dim AccessThreadID As Long



On Error Resume Next

s = "Sorry...cannot find the MouseHook.dll file" & vbCrLf

s = s & "Please copy the MouseHook.dll file to your Windows System folder or into the same folder as this Access MDB."

hLib = LoadLibrary("MouseHook.dll")

If hLib = 0 Then

    hLib = LoadLibrary(CurrentDBDir() & "MouseHook.dll")

    If hLib = 0 Then

        MsgBox s, vbOKOnly, "MISSING MOUSEHOOK.dll FILE"

        MouseWheelOFF = False

        Exit Function

    End If

End If

AccessThreadID = GetCurrentThreadId()

MouseWheelOFF = StopMouseWheel(Application.hWndAccessApp, AccessThreadID, GlobalHook)

End Function



Function CurrentDBDir() As String

Dim strDBPath As String

Dim strDBFile As String

    strDBPath = CurrentDb.NAME

    strDBFile = Dir(strDBPath)

    CurrentDBDir = Left$(strDBPath, Len(strDBPath) - Len(strDBFile))

End Function