Visual Basic Foro

acabo de probarlo y funciona bien, gracias.

salu2,

Tack0

Buenos dias coco,

ante todo agradecer por este post, llevo mucho tiempo buscando un ocx o ctl de un scroll horizontal y vertical que pueda ser tematizado (office 2007, 2010, xp, etc) y que tenga el evento de la rueda del mouse para hacer scroll (ademas de los clásicos botones izquierdo y derecho).

la ocx convencional del vb6 no tiene temas (lo del scroll con la rueda del mouse lo resolvi con un codigo que descargue y me sirvió), posteriormente descargué las librerias del codejock (que si tienen temas) pero no cogen el scroll con la rueda del mouse. El control framework permite tematizar los controles convencionales pero el scroll con la rueda del mouse con el codigo anteriorme nte mencionado ya no trabaja.

en resumen, su control pudiera ayudarme mucho y por eso le agradezco.

Pregunto:

Tiene una version mas avanzada del mismo o esto es ya un proyecto cerrado?.

Pudiera pensar en hacer un control similar no para mimetizar la barra de desplazamiento de windows media sino para hacer un scroll horizontal/vertical que pueda ser tematizado y que además responda al evento del scroll con la rueda del mouse?.

saludos,

Tack0

nota: el código que mencionaba anteriormente se lo pongo a continuacion
' Funciones API para hacer trapping a los botones del mouse para agregar a un scrollbar
' el scroll del mouse y eliminar de los controles textbox el menu emergente.
'-----------------------------------------------------------------------------
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
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
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, wParam As Any, lParam As Any) As Long
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Const GWL_WNDPROC = (-4)
Const WM_RBUTTONDOWN = &H204
Const SM_CYHSCROLL = 3
Const SM_CXVSCROLL = 2
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_VSCROLL As Integer = &H115

Public PrevProc As Long
' Procedimiento de ventana que devuelve el puntero al boton que se presiona
'-----------------------------------------------------------------------------
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If uMsg = WM_RBUTTONDOWN Then Exit Function
  WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
  If uMsg = WM_MOUSEWHEEL Then
        If wParam < 0 Then
            'Scroll hacia abajo
            SendMessage hwnd, WM_VSCROLL, ByVal 1, ByVal hwnd
                    Else
            ' scroll hacia arriba
            SendMessage hwnd, WM_VSCROLL, ByVal 0, ByVal hwnd
        End If
  End If
End Function

' instala el hook
Public Sub Hook(Obj As Object)
    PrevProc = SetWindowLong(Obj.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

' quita el hook
Public Sub UnHook(Obj As Object)
    SetWindowLong Obj.hwnd, GWL_WNDPROC, PrevProc
    PrevProc& = 0
End Sub