Déplacer une scrollbar avec la roulette de la souris
cs_eddoud
Messages postés
22
Date d'inscription
vendredi 6 janvier 2006
Statut
Membre
Dernière intervention
23 février 2006
-
22 févr. 2006 à 13:43
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 - 23 févr. 2006 à 15:37
PCPT Messages postés 13272 Date d'inscription lundi 13 décembre 2004 Statut Membre Dernière intervention 3 février 2018 - 23 févr. 2006 à 15:37
3 réponses
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
22 févr. 2006 à 20:56
22 févr. 2006 à 20:56
salut,
en cherchant tu aurais trouvé (LES VACANCES DE MR MULOT)
bref :
sur une Form1, pose une ScrollBar verticale nommée VScroll1 et colle y ce code :
Option Explicit
Private Const StepOfMoving As Long = 1000&
'
'
' *- FORM LOAD -*
Private Sub Form_Load()
' info pour l'exemple non -compilé
MsgBox "!!! SUBCLASSING !!!" & vbCrLf & "Ne pas fermer par le bouton STOP de l'IDE", _
vbExclamation, "Attention"
' DEMARRE LE SUBCLASSING
Call Mod_SClassWheel.StartSubclass_WHEEL(Me.hwnd)
End Sub
'
'
' *- FORM UNLOAD -*
Private Sub Form_Unload(Cancel As Integer)
' FIN DE SUBCLASSING
Call Mod_SClassWheel.StopSubclass_WHEEL(Me.hwnd)
End Sub
'
'
' *- MOUSE WHEEL -*
Public Sub SetEvent_WHEEL(sDirection As Long)
' on bouge la fenêtre et on indique en fenêtre d'exécution
If sDirection = cWheelUp Then
' la molette est Scrollée vers le haut
If VScroll1.Value - StepOfMoving > VScroll1.Min Then
VScroll1.Value = VScroll1.Value - StepOfMoving
End If
Else
' la molette est Scrollée vers le bas
If VScroll1.Value + StepOfMoving < VScroll1.Max Then
VScroll1.Value = VScroll1.Value + StepOfMoving
End If
End If
End Sub
<small> Coloration
syntaxique automatique [AFCK] </small>
ensuite dans un module nommé Mod_SClassWheel, met ce code :
' [AFCK] SubClassing MouseWheel 18 oct 2005
'
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 GWL_WNDPROC = (-4)
'
Public Const cWheelUp As Integer = 1
Public Const cWheelDown As Integer = -1
'
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
' MouseWheel, on déclenche l'évènement avec la direction
New_WindowProc = True
If wParam < 0 Then
Call Form1.SetEvent_WHEEL(cWheelDown)
Else
Call Form1.SetEvent_WHEEL(cWheelUp)
End If
Else
' les autres messages de SubClassing ne nous intéressent pas ;)
New_WindowProc = CallWindowProc(Old_WindowProc, hwnd, Msg, wParam, lParam)
End If
End Function
'
'
Public Sub StartSubclass_WHEEL(hwnd As Long)
Old_WindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf New_WindowProc)
End Sub
'
'
Public Sub StopSubclass_WHEEL(hwnd As Long)
Call SetWindowLong(hwnd, GWL_WNDPROC, Old_WindowProc)
End Sub
<small> Coloration
syntaxique automatique [AFCK]</small>
@+
PCPT [AFCK]
en cherchant tu aurais trouvé (LES VACANCES DE MR MULOT)
bref :
sur une Form1, pose une ScrollBar verticale nommée VScroll1 et colle y ce code :
Option Explicit
Private Const StepOfMoving As Long = 1000&
'
'
' *- FORM LOAD -*
Private Sub Form_Load()
' info pour l'exemple non -compilé
MsgBox "!!! SUBCLASSING !!!" & vbCrLf & "Ne pas fermer par le bouton STOP de l'IDE", _
vbExclamation, "Attention"
' DEMARRE LE SUBCLASSING
Call Mod_SClassWheel.StartSubclass_WHEEL(Me.hwnd)
End Sub
'
'
' *- FORM UNLOAD -*
Private Sub Form_Unload(Cancel As Integer)
' FIN DE SUBCLASSING
Call Mod_SClassWheel.StopSubclass_WHEEL(Me.hwnd)
End Sub
'
'
' *- MOUSE WHEEL -*
Public Sub SetEvent_WHEEL(sDirection As Long)
' on bouge la fenêtre et on indique en fenêtre d'exécution
If sDirection = cWheelUp Then
' la molette est Scrollée vers le haut
If VScroll1.Value - StepOfMoving > VScroll1.Min Then
VScroll1.Value = VScroll1.Value - StepOfMoving
End If
Else
' la molette est Scrollée vers le bas
If VScroll1.Value + StepOfMoving < VScroll1.Max Then
VScroll1.Value = VScroll1.Value + StepOfMoving
End If
End If
End Sub
<small> Coloration
syntaxique automatique [AFCK] </small>
ensuite dans un module nommé Mod_SClassWheel, met ce code :
' [AFCK] SubClassing MouseWheel 18 oct 2005
'
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 GWL_WNDPROC = (-4)
'
Public Const cWheelUp As Integer = 1
Public Const cWheelDown As Integer = -1
'
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
' MouseWheel, on déclenche l'évènement avec la direction
New_WindowProc = True
If wParam < 0 Then
Call Form1.SetEvent_WHEEL(cWheelDown)
Else
Call Form1.SetEvent_WHEEL(cWheelUp)
End If
Else
' les autres messages de SubClassing ne nous intéressent pas ;)
New_WindowProc = CallWindowProc(Old_WindowProc, hwnd, Msg, wParam, lParam)
End If
End Function
'
'
Public Sub StartSubclass_WHEEL(hwnd As Long)
Old_WindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf New_WindowProc)
End Sub
'
'
Public Sub StopSubclass_WHEEL(hwnd As Long)
Call SetWindowLong(hwnd, GWL_WNDPROC, Old_WindowProc)
End Sub
<small> Coloration
syntaxique automatique [AFCK]</small>
@+
PCPT [AFCK]
cs_eddoud
Messages postés
22
Date d'inscription
vendredi 6 janvier 2006
Statut
Membre
Dernière intervention
23 février 2006
23 févr. 2006 à 14:36
23 févr. 2006 à 14:36
le probleme c que c pas une scrollbar que g créé c la scrollbar de ma feuille MDI et donc je sais pas comment il nomme la scrollbar vertical et donc je peut pas appliquer de programe sur celle-ci.
PCPT
Messages postés
13272
Date d'inscription
lundi 13 décembre 2004
Statut
Membre
Dernière intervention
3 février 2018
47
23 févr. 2006 à 15:37
23 févr. 2006 à 15:37
dans l'idée çà reste plus ou moins pareil.
dans le module, remplace Form1 par MDIForm1
dans la Feuille mère, remplace le nom des évènements Form par MDIForm
et enfin :
'
'
' *- MOUSE WHEEL -*
Public Sub SetEvent_WHEEL(sDirection As Long)
' on bouge la fenêtre et on indique en fenêtre d'exécution
If sDirection = cWheelUp Then
' la molette est Scrollée vers le haut
Form1.Top = Form1.Top + 100
Else
' la molette est Scrollée vers le bas
Form1.Top = Form1.Top + -100
End If
End Sub
<small> Coloration
syntaxique automatique [AFCK]</small>
à toi de paufiner (voir existance de la Form ou des Forms filles, tailles, etc.....)
la scroll étant créée et détruite dynamiquement, tu ne peux apparemment pas le contrôler directement
++
dans le module, remplace Form1 par MDIForm1
dans la Feuille mère, remplace le nom des évènements Form par MDIForm
et enfin :
'
'
' *- MOUSE WHEEL -*
Public Sub SetEvent_WHEEL(sDirection As Long)
' on bouge la fenêtre et on indique en fenêtre d'exécution
If sDirection = cWheelUp Then
' la molette est Scrollée vers le haut
Form1.Top = Form1.Top + 100
Else
' la molette est Scrollée vers le bas
Form1.Top = Form1.Top + -100
End If
End Sub
<small> Coloration
syntaxique automatique [AFCK]</small>
à toi de paufiner (voir existance de la Form ou des Forms filles, tailles, etc.....)
la scroll étant créée et détruite dynamiquement, tu ne peux apparemment pas le contrôler directement
++
