Problema con scrollbars en VB6

[David]

Pues bien, debes colocar este código en el módulo:

Código:

Option Explicit
Private OldWindowProc As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal fnBar As Long, ByRef lpsi As SCROLLINFO, ByVal fRedraw As Boolean) As Long
Private Declare Function GetScrollInfo Lib "user32" (ByVal hWnd As Long, ByVal fnBar As Long, ByRef lpsi As SCROLLINFO) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SETREDRAW As Long = &HB&
Private Const GWL_WNDPROC = (-4)
Private Const WM_HSCROLL = &H114
Private Const SB_HORZ As Long = 0
Private Const SIF_ALL As Long = &H1F
Private Const SB_THUMBPOSITION As Long = 4
Private Type SCROLLINFO
    cbSize As Long
    fMask As Long
    nMin As Long
    nMax As Long
    nPage As Long
    nPos As Long
    nTrackPos As Long
End Type
Private Scroll As SCROLLINFO
Private vhWnd As Long
Sub PaintForm(ByVal hWnd As Long, ByVal Enabled As Boolean)
If Enabled Then
    Call SendMessage(hWnd, WM_SETREDRAW, 1&, 0&)
Else
    Call SendMessage(hWnd, WM_SETREDRAW, 0&, 0&)
End If
End Sub
Public Sub RestartScroll()
SetScrollInfo vhWnd, SB_HORZ, Scroll, True
SendMessage vhWnd, WM_HSCROLL, (IIf((Scroll.nPos < 1), 1, Scroll.nPos) * &H10000) Or SB_THUMBPOSITION, ByVal 0&
End Sub
Public Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Long) As Long
If Msg = WM_HSCROLL Then
    'Obtenemos la posición del Scroll
    Scroll.fMask = SIF_ALL
    Scroll.cbSize = Len(Scroll)
    GetScrollInfo hWnd, SB_HORZ, Scroll
    vhWnd = hWnd
End If
NewWindowProc = CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam)
End Function
Public Sub SetWindowProc(ByVal hWnd As Long)
OldWindowProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf NewWindowProc)
End Sub

En la ventana:

Código:

 
Private Sub Form_Load()
'Cambiamos el procedimiento para capturar los mensajes
SetWindowProc Grid.hWnd
End Sub
Private Sub Grid_LeaveCell()
'Desactivamos repintado del Grid
PaintFor Grid.hWnd, False
End Sub
Private Sub Grid_SelChange()
'Restablecemos la última posición del Scroll
RestartScroll
'Activamos repintado del Grid
PaintForm Grid.hWnd, True
'Actualizamos el Grid
Grid.Refresh
End Sub

© Este código lo hice consultando los siguientes códigos disponibles en Internet:
http://www.recursosvisualbasic.com.a...r-listview.htm (Repintado de la ventana)
http://www.recursosvisualbasic.com.a...de-ventana.htm (Capturar mensajes de ventana)
http://www.forosdelweb.com/1276010-post107.html (Obtener posición de ScrollBar)