|
|
|
|
|
Vermutlich fehlt die Möglichkeit, bei einem
ProgressBar-Steuerelement (aus den Microsoft Common Controls)
Hintergrund- und Balkenfarbe einstellen zu können, weil das erst ab
Version 4.71 der Common Controls (ab Internet Explorer
4.0 bzw. Windows 98) möglich ist. Denn ab
dieser Version stehen API-Nachrichten zur Verfügung, über die Sie
die Farben setzen können. Da es einerseits einen speziellen
"Farbwert" (eine Konstante) zum Zurücksetzen auf die
voreingestellten Farben gibt, und andererseits auch nur
RGB-Farbwerte gesetzt werden können, kapseln wir die entsprechenden
Aufrufe in Hilfsfunktionen.
Die Funktion ProgressBarSetBackColor setzt die Hintergrundfarbe.
Ihr übergeben Sie die betreffende ProgressBar und optional den
gewünschten Farbwert. Hier können Sie allerdings auch die
Konstanten der Systemfarben übergeben. Mittels der Übersetzung
durch die API-Funktion OleTranslateColor wird automatisch dafür
gesorgt (siehe auch "Systemfarben-Dolmetscher"
khwoletranslatecolor.htm), dass immer eine gültige RGB-Farbe
an die ProgressBar gesendet wird. Lassen Sie die Farbangabe weg,
wird der Hintergrund der ProgressBar auf den voreingestellten Wert
(entspricht vb3DFace) zurückgesetzt. Die Funktion gibt den zuvor
gesetzten Farbwert zurück. In gleicher Weise setzen Sie mit der
Funktion ProgressBarSetBarColor die Farbe des Fortschrittsbalkens.
Private Declare Function OleTranslateColor Lib "oleaut32.dll" _
(ByVal lOleColor As Long, ByVal lHPalette As Long, _
ByRef lColorRef As Long) As Long
Private Declare Function SendMessageLong Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const CLR_DEFAULT = &HFF000000
Private Const PBM_SETBARCOLOR = &H409
Private Const PBM_SETBKCOLOR = &H2001
Public Function ProgressBarSetBackColor(ProgressBar As ProgressBar, _
Optional ByVal BackColor As OLE_COLOR = -1) As Long
Dim nBackColor As Long
If BackColor = -1 Then
ProgressBarSetBackColor = SendMessageLong(ProgressBar.hwnd, _
PBM_SETBKCOLOR, 0, CLR_DEFAULT)
Else
OleTranslateColor BackColor, 0&, nBackColor
ProgressBarSetBackColor = SendMessageLong(ProgressBar.hwnd, _
PBM_SETBKCOLOR, 0, nBackColor)
End If
End Function
Public Function ProgressBarSetBarColor(ProgressBar As ProgressBar, _
Optional ByVal BarColor As OLE_COLOR = -1) As Long
Dim nBarColor As Long
If BarColor = -1 Then
ProgressBarSetBarColor = SendMessageLong(ProgressBar.hwnd, _
PBM_SETBARCOLOR, 0, CLR_DEFAULT)
Else
OleTranslateColor BarColor, 0&, nBarColor
ProgressBarSetBarColor = SendMessageLong(ProgressBar.hwnd, _
PBM_SETBARCOLOR, 0, nBarColor)
End If
End Function
Die Gegenstücke dazu lässt das API jedoch vermissen. Sie
können die eingestellten Farbwerte nicht so ohne weiteres auslesen.
Die SendMessage-Funktion, über die Sie die Farben setzen, gibt aber
immerhin den vorgefundenen Farbwert zurück, wenn Sie eine neue
Farbe setzen. Wir nutzen dies, um so den Farbwert auszulesen,
während er durch einen anderen (im Prinzip x-beliebigen) ersetzt
wird, und senden den ausgelesenen Farbwert gleich wieder zurück.
Das geht so schnell, dass die kurzzeitige Änderung erst gar nicht
dargestellt wird.
Die Funktionen ProgressBarGetBackColor und ProgressBarGetBarColor
liefern Ihnen die aktuellen Farbwerte als RGB-Werte. Wird als
"Farbwert" jedoch die Voreinstellung ermittelt, gibt
ProgressBarGetBackColor die System-Farben-Konstante vb3DFace und
ProgressBarGetBarColor die System-Farben-Konstante vbHighlight
zurück.
Public Function ProgressBarGetBackColor(ProgressBar As ProgressBar) _
As Long
Dim nBackColor As Long
nBackColor = SendMessageLong(ProgressBar.hwnd, PBM_SETBKCOLOR, _
0, CLR_DEFAULT)
SendMessageLong ProgressBar.hwnd, PBM_SETBKCOLOR, 0, nBackColor
If nBackColor = CLR_DEFAULT Then
ProgressBarGetBackColor = vb3DFace
Else
ProgressBarGetBackColor = nBackColor
End If
End Function
Public Function ProgressBarGetBarColor(ProgressBar As ProgressBar) _
As Long
Dim nBarColor As Long
nBarColor = SendMessageLong(ProgressBar.hwnd, PBM_SETBARCOLOR, _
0, CLR_DEFAULT)
SendMessageLong ProgressBar.hwnd, PBM_SETBARCOLOR, 0, nBarColor
If nBarColor = CLR_DEFAULT Then
ProgressBarGetBarColor = vbHighlight
Else
ProgressBarGetBarColor = nBarColor
End If
End Function
Eine Vereinfachung bieten unsere Funktionen ProgressBarSetColors,
über die Sie beide Farben in einem Funktions-Aufruf setzen können,
und ProgressBarResetColors, über die Sie beide Farben zugleich auf
die voreinsgestellten Werte zurücksetzen können.
ProgressBarResetColors bietet zudem noch den optionalen Parameter
Inverted. Übergeben Sie hier True, werden die Voreinstellungsfarben
vertauscht.
Public Sub ProgressBarSetColors(ProgressBar As ProgressBar, _
ByVal BackColor As OLE_COLOR, ByVal BarColor As OLE_COLOR)
Dim nBackColor As Long
Dim nBarColor As Long
With ProgressBar
OleTranslateColor BackColor, 0&, nBackColor
SendMessageLong .hwnd, PBM_SETBKCOLOR, 0, nBackColor
OleTranslateColor BarColor, 0&, nBarColor
SendMessageLong .hwnd, PBM_SETBARCOLOR, 0, nBarColor
End With
End Sub
Public Sub ProgressBarResetColors(ProgressBar As ProgressBar, _
Optional ByVal Inverted As Boolean)
Dim nColor As Long
With ProgressBar
If Inverted Then
OleTranslateColor vb3DFace, 0&, nColor
SendMessageLong .hwnd, PBM_SETBARCOLOR, 0, nColor
OleTranslateColor vbHighlight, 0&, nColor
SendMessageLong .hwnd, PBM_SETBKCOLOR, 0, nColor
Else
SendMessageLong .hwnd, PBM_SETBKCOLOR, 0, CLR_DEFAULT
SendMessageLong .hwnd, PBM_SETBARCOLOR, 0, CLR_DEFAULT
End If
End With
End Sub
Die Prozedur ProgressBarInvertColors vertauscht die Farben jeder
beliebigen Farbkombination miteinander.
Public Sub ProgressBarInvertColors(ProgressBar As ProgressBar)
Dim nBackColor As Long
Dim nBarColor As Long
With ProgressBar
nBarColor = SendMessageLong(.hwnd, PBM_SETBKCOLOR, _
0, CLR_DEFAULT)
If nBarColor = CLR_DEFAULT Then
OleTranslateColor vb3DFace, 0&, nBarColor
End If
nBackColor = SendMessageLong(.hwnd, PBM_SETBARCOLOR, _
0, CLR_DEFAULT)
If nBackColor = CLR_DEFAULT Then
OleTranslateColor vbHighlight, 0&, nBackColor
End If
SendMessageLong .hwnd, PBM_SETBKCOLOR, 0, nBackColor
SendMessageLong .hwnd, PBM_SETBARCOLOR, 0, nBarColor
End With
End Sub
Zu guter Letzt gibt es mit den beiden Prozeduren
ProgressBarSetOrientation und ProgressBarSetScrolling eine kleine
Komfort-Hilfe. Wenn Sie die beiden Eigenschaften Orientation oder
Scrolling der ProgressBar ändern, werden die Farben automatisch auf
die Voreinstellungen zurückgesetzt. Die beiden Prozeduren ersparen
Ihnen die Mühe, die gerade eingestellten Farben vorher extra
auslesen und hinterher extra wieder setzen zu müssen, wenn Sie die
beiden Eigenschaften über diese Prozeduren indirekt setzen.
Public Sub ProgressBarSetOrientation(ProgressBar As ProgressBar, _
Optional ByVal Orientation As OrientationConstants _
= ccOrientationHorizontal)
Dim nBarColor As Long
Dim nBackColor As Long
nBarColor = ProgressBarGetBarColor(ProgressBar)
nBackColor = ProgressBarGetBackColor(ProgressBar)
ProgressBar.Orientation = Orientation
ProgressBarSetBackColor ProgressBar, nBackColor
ProgressBarSetBarColor ProgressBar, nBarColor
End Sub
Public Sub ProgressBarSetScrolling(ProgressBar As ProgressBar, _
Optional ByVal Scrolling As ScrollingConstants _
= ccScrollingStandard)
Dim nBarColor As Long
Dim nBackColor As Long
nBarColor = ProgressBarGetBarColor(ProgressBar)
nBackColor = ProgressBarGetBackColor(ProgressBar)
ProgressBar.Scrolling = Scrolling
ProgressBarSetBackColor ProgressBar, nBackColor
ProgressBarSetBarColor ProgressBar, nBarColor
End Sub
|
|
|