Progress Bar

[joefoulkes]

Is it possible to change the fill colour of the standard vb progress bar ?

For example, I've got a progress bar which shows cpu usage (0% - 100%) and I want to make it go red when the cpu usage gets to around 85%.

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 Const WM_USER = &H400

Private Const PBM_SETBARCOLOR = WM_USER + 9
Private Const PBM_SETBKCOLOR = &H2000 + 1

Public Function SetPBBackColor(ProgressBar As Object, _
   NewColor As OLE_COLOR) As Boolean

On Error Resume Next
Dim lRet As Long
lRet = SendMessage(ProgressBar.hwnd, PBM_SETBKCOLOR, 0&, NewColor)

End Function

Public Function SetPBBarColor(ProgressBar As Object, _
   NewColor As OLE_COLOR) As Boolean

On Error Resume Next
Dim lRet As Long
lRet = SendMessage(ProgressBar.hwnd, PBM_SETBARCOLOR, 0&, NewColor)

End Function


Usage

SetPBBackColor ProgressBar1, vbRed

[joefoulkes]

Thanks for that !

I don't know if you've tried that code yourself, but on mine the bar always goes green - no matter what color I pass in.

How about making your own Progressbar with this code from HeSaidJoe?

'use a progress bar
'make a standard app and add a picture box called Progress
'in the PublicSub DoProgress..rename the frmSaveApps to your form name
'cut and paste the code and run to see an example
'
'<<<<<<<  Put this in a bas module  >>>>>>>>

'replace frmTips with the name of your app form
'or name your form frmTips for this example

Option Explicit

'number of things to do ex..files to be backed up
Public intCounted#  
'
Public Sub DoProgress(Percent)
'
' Percent is % of graph
'
Dim Work As Integer
Dim Num As String
'
Work = Int(Abs(Percent))
If Work > 100 Then Work = 100
'
With frmSaveTips.Progress       '<<<   With application form
    .BackColor = vbWhite        '<<<   White background
    If Not .AutoRedraw Then     '<<<   picture in memory ?
    .AutoRedraw = True          '<<<   make one
    End If
    
    .Cls                        '<<<   clear picture in memory
    .ScaleWidth = 100           '<<<   new scalemodus
    .DrawMode = 10              '<<<   not XOR Pen Modus

    Num = Format$(Work, "###") + "% Completed"

    .CurrentX = 50 - .TextWidth(Num) / 2         '<<<  %age is Centered

    .CurrentY = (.ScaleHeight - .TextHeight(Num)) / 2

    frmSaveTips.Progress.ForeColor = vbBlack     '<<<  Black text
    frmSaveTips.Progress.Print Num               '<<<  print percent

    frmSaveTips.Progress.Line (0, 0)-(Work, .ScaleHeight), vbBlue, BF
    .Refresh          '<<<  show
End With
'
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'  <<<<<<<<<<<<   event code for form   >>>>>>>>>>>>>>>>>>>

Private Sub Command1_Click()

intTotalCount = 1000    'whatever..use 1000 for this example

'print the line & increment the count

Dim i, copied

For i = 1 To 1000
 
    Print "This is a progress bar sample!"
    
    copied = copied + 1    'increment for progress bar
    Call DoProgress(copied / intTotalCount * 100)   'progress bar set to 100
 Next i

End Sub