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
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 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 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
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_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".
"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
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 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 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
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_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".
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 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 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
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_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".