OVH Cloud OVH Cloud

slider

1 réponse
Avatar
William
est-il possible de changer la couleur de fond d'un slider ?
si oui comment !
merci

1 réponse

Avatar
François Picalausa
Bonjour/soir,

Tu peux créer le contrôle par APIs auquel cas, il prend la couleur de fond
de son container.
Voici un exemple.
L'objet Subclasser correspond à un ActiveX Dll de sous classement; son
événement message est appelé lorsqu'un message est envoyé à la fenêtre
sous-classée, en l'occurence, la fenêtre parente.
'A placer dans une feuille avec un label
'Diverses constantes supplémentaires sont fournies à titre indicatif
Option Explicit

Private Const TRACKBAR_CLASS As String = "msctls_trackbar32"

Private hwndTrack As Long
Private ID_TRACKBAR As Long

Private Const WM_USER = &H400
Private Const SW_HIDE = 0

Private Const WM_HSCROLL = &H114
Private Const WM_VSCROLL = &H115

Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000

Private Const TBS_AUTOTICKS = &H1 ' automatically set tick position
Private Const TBS_VERT = &H2 ' vertical trackbar
Private Const TBS_HORZ = &H0 ' Horizontal trackbar
Private Const TBS_TOP = &H4 ' tick marks above trackbar
Private Const TBS_BOTTOM = &H0 ' tick marks below trackbar
Private Const TBS_LEFT = &H4 ' tick marks to left of trackbar
Private Const TBS_RIGHT = &H0 ' tick marks to right of trackbar
Private Const TBS_BOTH = &H8 ' tick marks on both sides of trackbar
Private Const TBS_NOTICKS = &H10 ' trackbar will not display any tick
marks.
Private Const TBS_ENABLESELRANGE = &H20 ' trackbar can display a selection
range
Private Const TBS_NOTHUMB = &H80 ' trackbar does not display a slider.

Private Const TBM_GETPOS = (WM_USER)
Private Const TBM_GETRANGEMIN = (WM_USER + 1)
Private Const TBM_GETRANGEMAX = (WM_USER + 2)
Private Const TBM_GETTIC = (WM_USER + 3)
Private Const TBM_SETTIC = (WM_USER + 4)
Private Const TBM_SETPOS = (WM_USER + 5)
Private Const TBM_SETRANGE = (WM_USER + 6)
Private Const TBM_SETRANGEMIN = (WM_USER + 7)
Private Const TBM_SETRANGEMAX = (WM_USER + 8)
Private Const TBM_CLEARTICS = (WM_USER + 9)
Private Const TBM_SETSEL = (WM_USER + 10)
Private Const TBM_SETSELSTART = (WM_USER + 11)
Private Const TBM_SETSELEND = (WM_USER + 12)
Private Const TBM_GETPTICS = (WM_USER + 14)
Private Const TBM_GETTICPOS = (WM_USER + 15)
Private Const TBM_GETNUMTICS = (WM_USER + 16)
Private Const TBM_GETSELSTART = (WM_USER + 17)
Private Const TBM_GETSELEND = (WM_USER + 18)
Private Const TBM_CLEARSEL = (WM_USER + 19)
Private Const TBM_SETTICFREQ = (WM_USER + 20)
Private Const TBM_SETPAGESIZE = (WM_USER + 21)
Private Const TBM_GETPAGESIZE = (WM_USER + 22)
Private Const TBM_SETLINESIZE = (WM_USER + 23)
Private Const TBM_GETLINESIZE = (WM_USER + 24)
Private Const TBM_GETTHUMBRECT = (WM_USER + 25)
Private Const TBM_GETCHANNELRECT = (WM_USER + 26)
Private Const TBM_SETTHUMBLENGTH = (WM_USER + 27)
Private Const TBM_GETTHUMBLENGTH = (WM_USER + 28)
Private Const TBM_SETTOOLTIPS = (WM_USER + 29)
Private Const TBM_GETTOOLTIPS = (WM_USER + 30)
Private Const TBM_SETTIPSIDE = (WM_USER + 31)

Private Declare Function InitCommonControls Lib "Comctl32.dll" () As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA"
(ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As
String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal
nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu
As Long, ByVal hInstance As Long, lpParam As Any) 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 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function APISetFocus Lib "user32" Alias "SetFocus" (ByVal
hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal
nCmdShow As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As
Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long,
ByVal hWndNewParent As Long) As Long

'Sous classement
Private WithEvents Subclasser As SubclassIt.SubClassing

Private Sub Form_Initialize()
InitCommonControls '// loads common control's DLL
End Sub

Private Sub Form_Load()
CreateTrackBar Me.hWnd, 10, 10, 50, 150, 1, 9, 5, 2, True, True, False

Label1.Caption = GetValue ' 5

Set Subclasser = New SubclassIt.SubClassing
Subclasser.SubClass Me.hWnd
End Sub

Private Sub Form_Terminate()
DestroyControl
Subclasser.UnSubclassAll
Set Subclasser = Nothing
End Sub

Sub CreateTrackBar(hwndDlg As Long, x As Long, y As Long, width As Long,
height As Long, iMin As Integer, iMax As Integer, iValue As Long, pageSize
As Long, Vertical As Boolean, Autotick As Boolean, SelectionRange As
Boolean)
DestroyControl

Dim lngStyle As Long

lngStyle = lngStyle Or TBS_AUTOTICKS * Abs(Autotick)
lngStyle = lngStyle Or TBS_ENABLESELRANGE * Abs(SelectionRange)
lngStyle = lngStyle Or TBS_VERT * Abs(Vertical)

hwndTrack = CreateWindowEx(0, TRACKBAR_CLASS, "Trackbar Control",
WS_CHILD Or WS_VISIBLE Or lngStyle, x, y, width, height, Form1.hWnd,
ID_TRACKBAR, App.hInstance, ByVal 0&)
'// no extended styles
'// class name
'// title (caption)
'// style
'// control identifier
'// instance
'// no WM_CREATE parameter

SendMessage hwndTrack, TBM_SETRANGE, 1, ByVal MakeLong(iMin, iMax)
'// redraw flag
'// min. & max. positions
SendMessage hwndTrack, TBM_SETPAGESIZE, 0, ByVal pageSize
'// new page size
'SendMessage hwndTrack, TBM_SETSEL, 1, ByVal MakeLong(1, 1)

SendMessage hwndTrack, TBM_SETPOS, 1, ByVal iValue
'// redraw flag

APISetFocus (hwndTrack)
End Sub

Function GetValue() As Long
GetValue = SendMessage(hwndTrack, TBM_GETPOS, 0, ByVal 0&)
End Function

Sub DestroyControl()
If hwndTrack <> 0 Then
ShowWindow hwndTrack, SW_HIDE
SetParent hwndTrack, 0
DestroyWindow hwndTrack
hwndTrack = 0
End If
End Sub

Private Function MakeLong(wLow As Integer, wHigh As Integer) As Long
MakeLong = wLow + wHigh * &H10000
End Function

Private Sub Subclasser_Message(ByVal hWnd As Long, ByVal Msg As Long, ByVal
wParam As Long, ByVal lParam As Long, SetNewValue As Boolean, NewValue As
Long)
If Msg = WM_HSCROLL Or Msg = WM_VSCROLL Then
Label1.Caption = GetValue
End If
End Sub

Tu peux bien entendu implémenter ceci dans un usercontrol pour pouvoir le
réutiliser plus facilement et pour être certain de ne pas confondre les
WM_HSCROLL provenant de ton trackbar avec ceux d'autres contrôles.

Une autre méthode est de créer entièrement un usercontrol à la main, via les
événements mouse_up/down, keypress, ...

Une dernière méthode, plus compliquée, est d'utiliser un contrôle
"ownerdrawn".

--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com


"William" a écrit dans le message de
news:bmr7h3$1uh$
est-il possible de changer la couleur de fond d'un slider ?
si oui comment !
merci