| Pregunta: | 48490 - RUEDA DEL RATóN |
| Autor: | Agustín Dávila |
| Hola, mi pregunta es si alguien conoce alguna API que responda a la rueda del ratón para que me pueda hacer el scroll de un picturebox, como cualquier control de windows existente. Muchas gracias de antemano. | |
| Respuesta: | Gabriel Memmel |
| Hola, la solución más práctica y eficiente que encontré es utilizando DirectX, aquí te pongo un ejemplo sencillo, tenés que habilitar en las referencias la librería de DirectX, yo utilizo el 8: 'DirectX para la rueda del ratón ;-) Dim DX As New DirectX8 Dim DI As DirectInput8 Dim Mouse As DirectInputDevice8 Dim MouseState As DIMOUSESTATE Private Declare Function GetFocus Lib "user32" () As Long Private Function IniciarDX() As Boolean On Error Resume Next Set DI = DX.DirectInputCreate() ' Check to see if the pointer is valid If DI Is Nothing Then IniciarDX = False: Exit Function ' Get a pointer to keyboard and mouse device objects Set Mouse = DI.CreateDevice("guid_SysMouse") ' Check to see if pointers are valid If Mouse Is Nothing Then IniciarDX = False: Exit Function ' Set the data formats to the commmonly used keyboard and mouse Mouse.SetCommonDataFormat DIFORMAT_MOUSE ' Set cooperative level, this tells DI how much control we need Mouse.SetCooperativeLevel hWnd, DISCL_NONEXCLUSIVE Or DISCL_BACKGROUND ' Now we are ready to aquire (erm, get) our input devices Mouse.Acquire IniciarDX = True End Function Private Sub Form_Load() On Error Resume Next ' En caso de que DirectX inicie correctamente, habilita el Timer que "observará" al ratón If IniciarDX Then TimerMouse.Enabled = True End Sub Private Sub TimerMouse_Timer() On Error Resume Next Dim hW As Long, Rueda As Integer ' Obtiene el índice del control que tiene el foco hW = GetFocus ' Obtiene los valores actuales del ratón Mouse.GetDeviceStateMouse MouseState Rueda = MouseState.lZ / 120 ' Llama a la sub con los parámetros necesarios ' Esta parte puede ser obviada y ser insertado el código aquí mismo MouseScroll hW, Rueda End Sub Private Sub MouseScroll(hWnd as Long, Scroll as Integer) On Error Resume Next ' Por comodidad se creó esta sub, pero puede evitarse y escribir el código directamente en el Timer If hWnd = Objeto.hWnd Then ' Se verifica si el Objeto el cual se desea controlar está teniendo el foco en el instante ' Sentencias ' . ' . End If End Sub Private Sub Form_Unload(Cancel As Integer) On Error Resume Next ' Es muy importante destruir los objetos DirectX creados para liberar los recursos al cerrar la aplicación ' para esto debe evitarse usar el comando "End" en cualquier parte y siempre cerrar descargando "Unload" el Formulario Set Mouse = Nothing Set DI = Nothing End End Sub Espero les sirva a muchos ya que es algo bastante útil y buscado. | |