PCPT
Messages postés13272Date d'inscriptionlundi 13 décembre 2004StatutMembreDernière intervention 3 février 201847 14 nov. 2005 à 15:25
salut,
c'est faisable, par subclassing.
ici 2 évènements, le scroll, et le MouseDown [VB6] sur la barre de Scroll
'DANS UN MODULE
'
' PCPT [AFCK] 14 nov 2005
'
'module SubClassing appelant la procédure de la Form appelante au Scroll d'un objet
'
Option Explicit
'
'
Private 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
'
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const GWL_WNDPROC = (-4)
'
Private Old_WindowProc As Long
'
'
'
Private Function New_WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_MOUSEWHEEL Then
New_WindowProc = True
Call Form1.Scroll(wParam)
ElseIf Msg = WM_NCLBUTTONDOWN Then
New_WindowProc = True
Call Form1.Click
End If
New_WindowProc = CallWindowProc(Old_WindowProc, hwnd, Msg, wParam, lParam)
End Function
'
'
Public Sub StartSubclassing(hwnd As Long)
Old_WindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf New_WindowProc)
End Sub
'
'
Public Sub StopSubclassing(hwnd As Long)
Dim lngRetVal As Long
lngRetVal = SetWindowLong(hwnd, GWL_WNDPROC, Old_WindowProc)
End Sub
'Form1 contenant Text1 multiligne avec scroll verticale
Option Explicit
'
'
Private Sub Form_Load()
Text1.Text = "a " & vbCrLf & "a " & vbCrLf & "a " & _
vbCrLf & "a " & vbCrLf & "a " & vbCrLf & _
"a " & vbCrLf & "a " & vbCrLf & "a " & _
vbCrLf & "a " & vbCrLf & "a " & vbCrLf & _
"a " & vbCrLf & "a " & vbCrLf & "a " & _
vbCrLf & "a " & vbCrLf & "a " & vbCrLf & _
"a " & vbCrLf & "a " & vbCrLf & "a "
Call StartSubclassing(Text1.hwnd)
End Sub
'
'
Private Sub Form_Unload(Cancel As Integer)
Call StopSubclassing(Text1.hwnd)
End Sub
'
'
Public Sub Scroll(wParam As Long)
Debug.Print "SCROLL"
End Sub
Public Sub Click()
Debug.Print "CLICK"
End Sub
Wahou je ne m'attendais pas à çà.
je croyai que c'était plus simple que çà à mettre en place.
je vais accepter cette réponse, mais je ne pense pas l'utiliser.
je crois que je vais rusé en mettant quelque chose sur la scrollbar de transparent "genre une imagebox"