
17/06/2008, 09:42
|
 | Moderador | | Fecha de Ingreso: abril-2005 Ubicación: In this planet
Mensajes: 15.720
Antigüedad: 20 años Puntos: 839 | |
Respuesta: Problema con scrollbars en VB6 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) |