Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Développement Développement Visual Basic scrollbar

scrollbar

7 réponses
Avatar
hexadec
Je possède une scrollbar horizontale construite à partir d'un module de classe

Comment faire pour progammer son mouvement dans du code vb6 (Large ou small)

Merci
A++
Signaler un problème avec ce contenu

7 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Jacques93
Bonjour hexadec,
hexadec a écrit :
Je possède une scrollbar horizontale construite à partir d'un module de classe

Comment faire pour progammer son mouvement dans du code vb6 (Large ou small)




Sans connaître le contenu du module de classe, ça va pas être simple ;-)

--
Cordialement,

Jacques.
Avatar
hexadec
"Jacques93" a écrit :

Bonjour hexadec,
hexadec a écrit :
> Je possède une scrollbar horizontale construite à partir d'un module de classe
>
> Comment faire pour progammer son mouvement dans du code vb6 (Large ou small)
>

Sans connaître le contenu du module de classe, ça va pas être simple ;-)

--
Cordialement,

Jacques.



Merci à jacques qui me dépanne pour la deuxième fois !!

J'ose balancer le contenu du module de classe !!




Option Explicit
#If DEBUGWINDOWPROC Then
Private m_DWPHook As WindowProcHook
#End If
Private m_WinProcOld As Long
Private m_hWnd As Long
Private Enum HORZ_VERT: SB_HORZ = 0&: SB_VERT = 1&: End Enum
Private m_bHScroll As Boolean
Private m_bHDisableNoScroll As Boolean
Private m_nHSmallChange As Long
Private m_bVScroll As Boolean
Private m_bVDisableNoScroll As Boolean
Private m_nVSmallChange As Long
Private m_nHScrollPos As Long
Private m_nVScrollPos As Long
Private Const WM_HSCROLL As Long = &H114&
Private Const WM_VSCROLL As Long = &H115&
Private Const SB_CTL As Long = 2&
Private Const SB_BOTH As Long = 3&
Private Const SB_LINEUP As Long = 0&
Private Const SB_LINELEFT As Long = 0&
Private Const SB_LINEDOWN As Long = 1&
Private Const SB_LINERIGHT As Long = 1&
Private Const SB_PAGEUP As Long = 2&
Private Const SB_PAGELEFT As Long = 2&
Private Const SB_PAGEDOWN As Long = 3&
Private Const SB_PAGERIGHT As Long = 3&
Private Const SB_THUMBPOSITION As Long = 4&
Private Const SB_THUMBTRACK As Long = 5&
Private Const SB_TOP As Long = 6&
Private Const SB_LEFT As Long = 6&
Private Const SB_BOTTOM As Long = 7&
Private Const SB_RIGHT As Long = 7&
Private Const SB_ENDSCROLL As Long = 8&
Public Enum SIF_MASK
SIF_RANGE = &H1
SIF_PAGE = &H2
SIF_POS = &H4
SIF_DISABLENOSCROLL = &H8
SIF_TRACKPOS = &H10
SIF_ALL = SIF_RANGE Or SIF_PAGE Or SIF_POS
End Enum
Private Type SCROLLINFO
cbSize As Long
fMask As SIF_MASK
nMin As Long
nMax As Long
nPage As Long
nPos As Long
nTrackPos As Long
End Type
Private m_tagSCROLLINFO As SCROLLINFO
Private Declare Function GetScrollInfo Lib "user32" (ByVal hWnd&, ByVal
fnBar As HORZ_VERT, lpScrollInfo As SCROLLINFO) As Long
Private Declare Function SetScrollInfo Lib "user32" (ByVal hWnd&, ByVal
fnBar As HORZ_VERT, lpcScrollInfo As SCROLLINFO, ByVal fRedraw&) As Long
Private Declare Function ShowScrollBar Lib "user32" (ByVal hWnd&, ByVal
wBar&, ByVal bShow&) As Long
Event HChange(ByVal nCurPos As Long)
Event HScroll(ByVal nCurPos As Long)
Event VChange(ByVal nCurPos As Long)
Event VScroll(ByVal nCurPos As Long)
Friend Function ScrollProc(ByVal hWnd&, ByVal uMsg&, ByVal wParam&, ByVal
lParam&) As Long
Select Case uMsg
Case WM_VSCROLL
With Me
Select Case LOWORD(wParam)
Case SB_BOTTOM: .VPos = .VMax: RaiseEvent VChange(m_nVScrollPos)
Case SB_TOP: .VPos = .VMin: RaiseEvent VChange(m_nVScrollPos)
Case SB_LINEDOWN: .VPos = .VPos + m_nVSmallChange: RaiseEvent
VChange(m_nVScrollPos)
Case SB_LINEUP: .VPos = .VPos - m_nVSmallChange: RaiseEvent
VChange(m_nVScrollPos)
Case SB_PAGEDOWN: .VPos = .VPos + .VPage: RaiseEvent
VChange(m_nVScrollPos)
Case SB_PAGEUP: .VPos = .VPos - .VPage: RaiseEvent
VChange(m_nVScrollPos)
Case SB_THUMBPOSITION, SB_THUMBTRACK: .VPos = HIWORD(wParam):
RaiseEvent VScroll(m_nVScrollPos)
End Select
End With
ScrollProc = 0&
Exit Function
Case WM_HSCROLL
With Me
Select Case LOWORD(wParam)
Case SB_BOTTOM: .HPos = .HMax: RaiseEvent HChange(m_nHScrollPos)
Case SB_TOP: .HPos = .HMin: RaiseEvent HChange(m_nHScrollPos)
Case SB_LINERIGHT: .HPos = .HPos + m_nHSmallChange: RaiseEvent
HChange(m_nHScrollPos)
Case SB_LINELEFT: .HPos = .HPos - m_nHSmallChange: RaiseEvent
HChange(m_nHScrollPos)
Case SB_PAGERIGHT: .HPos = .HPos + .HPage: RaiseEvent
HChange(m_nHScrollPos)
Case SB_PAGELEFT: .HPos = .HPos - .HPage: RaiseEvent
HChange(m_nHScrollPos)
Case SB_THUMBPOSITION, SB_THUMBTRACK: .HPos = HIWORD(wParam):
RaiseEvent HScroll(m_nHScrollPos)
End Select
End With
ScrollProc = 0&
Exit Function
End Select
ScrollProc = CallWindowProc(m_WinProcOld, hWnd, uMsg, wParam, lParam)
End Function
Public Property Get HScroll() As Boolean: HScroll = m_bHScroll: End Property
Public Property Let HScroll(ByVal bNewVal As Boolean)
If m_bHScroll <> bNewVal Then
m_bHScroll = bNewVal
ShowSB SB_HORZ, bNewVal
End If: End Property
Public Property Get HMin() As Long
With m_tagSCROLLINFO
.fMask = SIF_RANGE
Call GetScrollInfo(m_hWnd, SB_HORZ, m_tagSCROLLINFO)
HMin = .nMin
End With: End Property
Public Property Let HMin(ByVal nNewVal As Long)
With m_tagSCROLLINFO
.fMask = SIF_RANGE
.nMin = nNewVal
.nMax = HMax
End With
CallSetHScrollInfo: End Property
Public Property Get HMax() As Long
With m_tagSCROLLINFO
.fMask = SIF_RANGE
Call GetScrollInfo(m_hWnd, SB_HORZ, m_tagSCROLLINFO)
HMax = .nMax
End With: End Property
Public Property Let HMax(ByVal nNewVal As Long)
With m_tagSCROLLINFO
.fMask = SIF_RANGE
.nMin = HMin
.nMax = nNewVal
End With: CallSetHScrollInfo: End Property
Public Property Get HPage() As Long
With m_tagSCROLLINFO
.fMask = SIF_PAGE
Call GetScrollInfo(m_hWnd, SB_HORZ, m_tagSCROLLINFO)
HPage = .nPage
End With: End Property
Public Property Let HPage(ByVal nNewVal As Long)
With m_tagSCROLLINFO
.fMask = SIF_PAGE
.nPage = nNewVal
End With: CallSetHScrollInfo: End Property
Public Property Get HPos() As Long
With m_tagSCROLLINFO
.fMask = SIF_POS
Call GetScrollInfo(m_hWnd, SB_HORZ, m_tagSCROLLINFO)
HPos = .nPos
End With: End Property
Public Property Let HPos(ByVal nNewVal As Long)
With m_tagSCROLLINFO
.fMask = SIF_POS
.nPos = nNewVal
End With: CallSetHScrollInfo: End Property
Public Property Get HSmallChange() As Long
HSmallChange = m_nHSmallChange: End Property
Public Property Let HSmallChange(ByVal nNewVal As Long)
m_nHSmallChange = nNewVal: End Property
Public Property Get HDisableNoScroll() As Boolean
HDisableNoScroll = m_bHDisableNoScroll: End Property
Public Property Let HDisableNoScroll(ByVal bNewVal As Boolean)
m_bHDisableNoScroll = bNewVal: End Property
Private Sub CallSetHScrollInfo()
If m_bHDisableNoScroll Then
With m_tagSCROLLINFO
.fMask = .fMask Or SIF_DISABLENOSCROLL
End With: End If: m_nHScrollPos = SetScrollInfo(m_hWnd, SB_HORZ,
m_tagSCROLLINFO, API_TRUE): End Sub
Public Property Get VScroll() As Boolean: VScroll = m_bVScroll: End Property
Public Property Let VScroll(ByVal bNewVal As Boolean)
If m_bVScroll <> bNewVal Then
m_bVScroll = bNewVal
ShowSB SB_VERT, bNewVal
End If: End Property
Public Property Get VMin() As Long
With m_tagSCROLLINFO
.fMask = SIF_RANGE
Call GetScrollInfo(m_hWnd, SB_VERT, m_tagSCROLLINFO)
VMin = .nMin
End With: End Property
Public Property Let VMin(ByVal nNewVal As Long)
With m_tagSCROLLINFO
.fMask = SIF_RANGE
.nMin = nNewVal
.nMax = VMax
End With: CallSetVScrollInfo: End Property
Public Property Get VMax() As Long
With m_tagSCROLLINFO
.fMask = SIF_RANGE
Call GetScrollInfo(m_hWnd, SB_VERT, m_tagSCROLLINFO)
VMax = .nMax
End With: End Property
Public Property Let VMax(ByVal nNewVal As Long)
With m_tagSCROLLINFO
.fMask = SIF_RANGE
.nMin = VMin
.nMax = nNewVal
End With: CallSetVScrollInfo: End Property
Public Property Get VPage() As Long
With m_tagSCROLLINFO
.fMask = SIF_PAGE
Call GetScrollInfo(m_hWnd, SB_VERT, m_tagSCROLLINFO)
VPage = .nPage
End With: End Property
Public Property Let VPage(ByVal nNewVal As Long)
With m_tagSCROLLINFO
.fMask = SIF_PAGE
.nPage = nNewVal
End With: CallSetVScrollInfo: End Property
Public Property Get VPos() As Long
With m_tagSCROLLINFO
.fMask = SIF_POS
Call GetScrollInfo(m_hWnd, SB_VERT, m_tagSCROLLINFO)
VPos = .nPos
End With: End Property
Public Property Let VPos(ByVal nNewVal As Long)
With m_tagSCROLLINFO
.fMask = SIF_POS
.nPos = nNewVal
End With: CallSetVScrollInfo: End Property
Public Property Get VSmallChange() As Long: VSmallChange = m_nVSmallChange:
End Property
Public Property Let VSmallChange(ByVal nNewVal As Long): m_nVSmallChange =
nNewVal: End Property
Public Property Get VDisableNoScroll() As Boolean: VDisableNoScroll =
m_bVDisableNoScroll: End Property
Public Property Let VDisableNoScroll(ByVal bNewVal As Boolean):
m_bVDisableNoScroll = bNewVal: End Property
Private Sub CallSetVScrollInfo()
If m_bVDisableNoScroll Then
With m_tagSCROLLINFO
.fMask = .fMask Or SIF_DISABLENOSCROLL
End With: End If: m_nVScrollPos = SetScrollInfo(m_hWnd, SB_VERT,
m_tagSCROLLINFO, API_TRUE): End Sub
Private Sub ShowSB(ByVal eType As HORZ_VERT, ByVal bShow As Boolean)
Dim fShow&
Select Case bShow
Case True: fShow = API_TRUE
Case False: fShow = API_FALSE
End Select: Call ShowScrollBar(m_hWnd, eType, fShow): End Sub
Public Sub SubClass(ByVal hWnd&)
If IsWindow(hWnd) Then
If GetProp(hWnd, "nvStdScroll") Then Exit Sub
If SetProp(hWnd, ByVal "nvStdScroll", ObjPtr(Me)) Then

#If DEBUGWINDOWPROC Then
Set m_DWPHook = CreateWindowProcHook
With m_DWPHook
.SetMainProc AddressOf MStdScrollBar.StdScrollProc
m_WinProcOld = SetWindowLong(hWnd, GWL_WNDPROC, .ProcAddress)
.SetDebugProc m_WinProcOld
End With
#Else
m_WinProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf
MStdScrollBar.StdScrollProc)
#End If
m_hWnd = hWnd
End If: End If: End Sub
Private Sub UnSubClass()
If IsWindow(m_hWnd) Then
If m_WinProcOld Then
SetWindowLong m_hWnd, GWL_WNDPROC, m_WinProcOld
RemoveProp m_hWnd, "nvStdScroll"
m_WinProcOld = 0
m_hWnd = 0
End If
#If DEBUGWINDOWPROC Then
Set m_DWPHook = Nothing
#End If
End If: End Sub
Private Sub Class_Initialize(): m_tagSCROLLINFO.cbSize =
Len(m_tagSCROLLINFO): End Sub
Private Sub Class_Terminate(): UnSubClass: End Sub








Avatar
Jacques93
Bonsoir Hexadec,
hexadec a écrit :

"Jacques93" a écrit :

Bonjour hexadec,
hexadec a écrit :
Je possède une scrollbar horizontale construite à partir d'un module de classe

Comment faire pour progammer son mouvement dans du code vb6 (Large ou small)



Sans connaître le contenu du module de classe, ça va pas être simple ;-)

--
Cordialement,

Jacques.



Merci à jacques qui me dépanne pour la deuxième fois !!

J'ose balancer le contenu du module de classe !!




S'il s'agit bien de cet exemple :

http://www.activevb.de/tipps/vb6tipps/tipp0232.html

;-)

et qui effectivement n'expose pas de méthodes permettant de faire cela,
tu as le choix, soit dans le code de la feuille en ajoutant (juste pour
une ScrollBar horizontale) :

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_SCROLL As Long = 276& ' Scroll horizontal
Private Const SB_LINELEFT As Long = 0&
Private Const SB_PAGELEFT As Long = 2&
Private Const SB_LINERIGHT As Long = 1&
Private Const SB_PAGERIGHT As Long = 3&

et dans le code :

Smallchange à droite :

SendMessage Me.hWnd, WM_SCROLL, SB_LINERIGHT, 0

Smallchange à gauche :

SendMessage Me.hWnd, WM_SCROLL, SB_LINELEFT, 0

LargeChange à droite :

SendMessage Me.hWnd, WM_SCROLL, SB_PAGERIGHT, 0

LargeSmallchange à droite :

SendMessage Me.hWnd, WM_SCROLL, SB_PAGELEFT, 0


Mais tu peux aussi les ajouter en tant que méthode dans le module de
classe, par exemple :

Public Sub LineRight (ByVal hWnd&)
SendMessage Me.hWnd, WM_SCROLL, SB_LINERIGHT, 0
End Sub

etc...

NB : Les constantes sont déjà définies dans le module de classe, il faut
juste ajouter la déclaration de l'API SendMessage.

--
Cordialement,

Jacques.
Avatar
Jacques93
Jacques93 a écrit :

LargeSmallchange à droite :




LargeChange à gauche, bien sûr ...

SendMessage Me.hWnd, WM_SCROLL, SB_PAGELEFT, 0


Mais tu peux aussi les ajouter en tant que méthode dans le module de
classe, par exemple :

Public Sub LineRight (ByVal hWnd&)
SendMessage Me.hWnd, WM_SCROLL, SB_LINERIGHT, 0



SendMessage Me.hWnd, WM_HSCROLL, SB_LINERIGHT, 0

End Sub

etc...



et dans la feuille tu appelles ces méthodes avec :

oVScroll.LineRight Me.hWnd
oVScroll.LineRLeft Me.hWnd

etc...

Voilà, j'espère ne pas avoir fait d'autres fautes d'inattention :-)

--
Cordialement,

Jacques.
Avatar
LE TROLL
Bonjour Jacques,

La vache, tout ce code c'est pour juste faire une barre de défilement ???

-----------------


"Jacques93" a écrit dans le message de news:

Jacques93 a écrit :

LargeSmallchange à droite :




LargeChange à gauche, bien sûr ...

SendMessage Me.hWnd, WM_SCROLL, SB_PAGELEFT, 0


Mais tu peux aussi les ajouter en tant que méthode dans le module de
classe, par exemple :

Public Sub LineRight (ByVal hWnd&)
SendMessage Me.hWnd, WM_SCROLL, SB_LINERIGHT, 0



SendMessage Me.hWnd, WM_HSCROLL, SB_LINERIGHT, 0

End Sub

etc...



et dans la feuille tu appelles ces méthodes avec :

oVScroll.LineRight Me.hWnd
oVScroll.LineRLeft Me.hWnd

etc...

Voilà, j'espère ne pas avoir fait d'autres fautes d'inattention :-)

--
Cordialement,

Jacques.


Avatar
Jacques93
Bonsoir LE TROLL,
LE TROLL a écrit :
Bonjour Jacques,

La vache, tout ce code c'est pour juste faire une barre de défilement ???

-----------------



Ben oui, si ça plait à hexadec d'utiliser cela, pourquoi pas, chacun à
sa manière de voir les choses. Mais juste pour mémoire, avant VB, ou
sans VB et les contrôles ActiveX intégrés ou associés au produit ,sous W
3.x ça ce programmait comme cela. C'est plus lourd en nombre de lignes,
pas de doute, mais plus souple, on fait ce qu'on veut ...

--
Cordialement,

Jacques.
Avatar
hexadec
"hexadec" a écrit :

Je possède une scrollbar horizontale construite à partir d'un module de classe

Comment faire pour progammer son mouvement dans du code vb6 (Large ou small)

Merci
A++






Merci à Jacques, mais comme j'ai un cerf-volant ( CERVEAU LENT ) cela va
prendre du temps de tout bien comprendre.

Je fais de la programmation plus basique pour des logiciels de bourse !!

A++