MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Trava roda mouse para 64 bits

    Compartilhe

    gracymary
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 188
    Registrado : 16/10/2010

    Trava roda mouse para 64 bits

    Mensagem  gracymary em 9/4/2018, 20:09

    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

    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

      Data/hora atual: 24/9/2018, 15:05