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