Private Const WM_USER = &H400
Private Const CCM_FIRST As Long = &H2000&
Private Const CCM_SETBKCOLOR As Long = (CCM_FIRST + 1)
'set progressbar backcolor in IE3 or later
Private Const PBM_SETBKCOLOR As Long = CCM_SETBKCOLOR
'set progressbar barcolor in IE4 or later
Private Const PBM_SETBARCOLOR As Long = (WM_USER + 9)
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 Sub Form_Load()
SetProgressBarColour ProgressBar2.hwnd, RGB(205, 0, 0)
SetProgressBarColour ProgressBar3.hwnd, RGB(0, 205, 0)
SetProgressBarColour ProgressBar4.hwnd, RGB(205, 205, 0)
End Sub
Private Sub Command1_Click()
Static cnt As Long
Static action As Boolean
action = Not action
If action = True Then
Command1.Caption = "Stop"
For cnt = 1 To ProgressBar1.Max
ProgressBar1.Value = cnt
ProgressBar2.Value = cnt
ProgressBar3.Value = cnt
ProgressBar4.Value = cnt
'needed to trap cancel click
DoEvents
Next
Else
Command1.Caption = "Run"
cnt = ProgressBar1.Max
End If
End Sub
Private Sub Command2_Click()
Dim clrref As Long
On Local Error GoTo Command2_error
With CommonDialog1
.CancelError = True
.ShowColor
SetProgressBarColour ProgressBar4.hwnd, .Color
End With
Command2_exit:
Exit Sub
Command2_error:
Resume Command2_exit
End Sub
Private Sub Command3_Click()
Dim clrref As Long
On Local Error GoTo Command3_error
With CommonDialog1
.CancelError = True
.ShowColor
SetProgressBackColour ProgressBar4.hwnd, .Color
End With
Command3_exit:
Exit Sub
Command3_error:
Resume Command3_exit
End Sub
Private Sub SetProgressBarColour(hwndProgBar As Long, ByVal clrref As Long)
Call SendMessage(hwndProgBar, PBM_SETBARCOLOR, 0&, ByVal clrref)
End Sub
Private Sub SetProgressBackColour(hwndProgBar As Long, ByVal clrref As Long)
Call SendMessage(hwndProgBar, PBM_SETBKCOLOR, 0&, ByVal clrref)
End Sub