Color progressbar

[bbUFO]

Does anybody know how to change the color for progressbar in VB6?
Thanks

http://www.planet-source-code.com/vb...txtCodeId=5117

[nitrolic2]

cant u do it in design time?

oh yeah huh

[Chris]

Will it be good if you create your own ProgressBar with full control of the ProgressBar Color and Progress Status Text style + Color?

Here is the code that wrote by me. May be you can convert it into an OCX, if you think it is necessary.

In my code, I just use the Timer as for Demo purpose, so it can be remove for your case.

For the ProgressBar, it only need a PictureBox Contol

Code under basic Form
Option Explicit
Public PROGRESS As Long

Private Sub Command2_Click()
'Initialize ProgressBar
Init_ProgressBar Picture1

'Set the Text Color
pTextColor = vbBlue

'Reset the Progress value
PROGRESS = 0
pMIN = 0
pMAX = 100
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Picture1.AutoRedraw = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub

Private Sub Timer1_Timer()
'Increase the ProgressBar value
PROGRESS = PROGRESS + 1
'Debug.Print PROGRESS

Update_Progress PROGRESS, Picture1

'Check for Max value.
If PROGRESS = pMAX Then
    Timer1.Enabled = False
End If
End Sub

Code under Basic Module
Option Explicit
Public Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SetRectEmpty Lib "user32" (lpRect As RECT) As Long
Public Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
Public Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long


Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public rc As RECT

Public Const BS_SOLID = 0
Public Const HS_SOLID = 8

Public Type LOGBRUSH
    lbStyle As Long
    lbColor As Long
    lbHatch As Long
End Type
Public LB As LOGBRUSH

Public pDC As Long
Public pBrush As Long
Public pTextColor As Long
Public pTextTop As Long
Public pTextLeft As Long

Public pMAX As Long
Public pMIN As Long
Private pRatio As Long
Private pHeight As Long
Private pWidth As Long
Public Sub Update_Progress(ByVal nProgress As Long, ByVal ProgressBar As PictureBox)
'Reset the ProgressBar
ProgressBar.Cls

'Get new ProgressBar Device Context
pDC = ProgressBar.hdc

'Create a new brush
Create_Brush

'Re-Initialize the Text Color
Init_TextColor

''Calculate the Fill ratio
pRatio = (nProgress / pMAX) * ProgressBar.ScaleX(ProgressBar.Width, vbTwips, vbPixels)
frmMain.Caption = nProgress & "% in progress..."

'Resize the Progress Bar region
SetRect rc, 0, 0, pRatio, pHeight

'Fill the Rect + Print the TEXT
FillRect pDC, rc, pBrush
TextOut pDC, pTextLeft, pTextTop, nProgress & "%", Len(Trim(nProgress)) + 1
ProgressBar.Refresh

'Delete the existing Brush handle
DeleteObject pBrush
SetRectEmpty rc

End Sub

Public Sub Init_ProgressBar(ByVal ProgressBar As PictureBox)
'Set the ProgressBar Height according to PictureBox Height
pHeight = ProgressBar.ScaleY(ProgressBar.Height, vbTwips, vbPixels)
pWidth = ProgressBar.ScaleY(ProgressBar.Width, vbTwips, vbPixels)
pTextLeft = (pWidth - ProgressBar.FontSize * 2) / 2
pTextTop = (pHeight - ProgressBar.FontSize * 2) / 2

'Initialize the Progress Rect
SetRect rc, 0, 0, 0, 0
End Sub

Public Sub Init_TextColor()
SetTextColor pDC, pTextColor

End Sub

Public Sub Create_Brush()
'Create Brush for ProgressBar Region
LB.lbColor = RGB(185, 255, 100)
LB.lbStyle = BS_SOLID
LB.lbHatch = HS_SOLID

pBrush = CreateBrushIndirect(LB)
End Sub

[Chris]

Hi bbUFO, recently I just convert my code into an OCX control. So do you interested?