Boa tarde! .. pra todos!!!
Preciso da ajuda de vocês,
Tenho uma função que trava a roda do mouse no formulário.. que funciona no sistema operacional - 32 bits.
Acontece que preciso dessa função para que funcione no - 64 bits.
Tentei.. de acordo com algumas pesquisas "acertar pra funcionar".. mas, não deu certo!
Agradeço, antecipadamente, a ajuda!!!
gracy
Preciso da ajuda de vocês,
Tenho uma função que trava a roda do mouse no formulário.. que funciona no sistema operacional - 32 bits.
Acontece que preciso dessa função para que funcione no - 64 bits.
Tentei.. de acordo com algumas pesquisas "acertar pra funcionar".. mas, não deu certo!
Agradeço, antecipadamente, a ajuda!!!
gracy
- Código:
Option Explicit
Private Declare PtrSafe Function VirtualAlloc Lib "kernel32" (ByVal Address As Long, ByVal Size As Long, ByVal AllocationType As Long, ByVal Protect As Long) As Long
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal ProcName As String) As Long
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal Module As Long, ByVal ProcName As String) As Long
Private Declare PtrSafe Sub CopyMemoryAnsi Lib "kernel32" Alias "RtlMoveMemory" (ByVal Dest As Long, ByVal Source As String, ByVal Size As Long)
Private Declare PtrSafe Sub CastToObject Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Object, ByRef Source As Long, ByVal Size As Long)
Private Const SIZEOF_PTR32 As Long = &H4
Private Const PAGE_EXECUTE_RW As Long = &H40
Private Const MEM_RESERVE_AND_COMMIT As Long = &H3000
Private Const ERR_OUT_OF_MEMORY As Long = &H7
Private Type IDispatchVTable
QueryInterface As Long
AddRef As Long
Release As Long
GetTypeInfoCount As Long
GetTypeInfo As Long
GetIDsOfNames As Long
Invoke As Long
End Type
Public Function NewMouseHook(ByRef Form As Access.Form) As Object
Dim NativeCode As String
Dim Kernel32Handle As Long
Dim GetProcAddressPtr As Long
Dim MouseHookAddr As Long
Dim MouseHookLoader As Object
Dim LoaderVTable As IDispatchVTable
If MouseHookAddr <> 0 Then
' Copy the x86 native code into the allocated memory
Call CopyMemoryAnsi(MouseHookAddr, NativeCode, Len(NativeCode))
' Force the memory address into an Object variable (also triggers the shell code)
LoaderVTable.QueryInterface = MouseHookAddr
Call CastToObject(MouseHookLoader, VarPtr(VarPtr(LoaderVTable)), SIZEOF_PTR32)
If Not TypeOf MouseHookLoader Is VBA.Collection Then
Set NewMouseHook = (MouseHookLoader)
Set MouseHookLoader = Nothing
End If
' Initialize our COM object
Kernel32Handle = GetModuleHandleA("kernel32")
GetProcAddressPtr = GetProcAddress(Kernel32Handle, "GetProcAddress")
Call NewMouseHook.Init(Kernel32Handle, GetProcAddressPtr, Form.hWnd)
' Disable the scroll wheel by default.
NewMouseHook.Scroll = False
Else
Err.Raise ERR_OUT_OF_MEMORY
End If
End Function