[VBnet ComCtrls] SendMessage: Change the Colour of a VB ProgressBar


	Visual Basic Common Control API Routines SendMessage: Change the Colour of a VB ProgressBar

Posted:	Monday October 29, 2001
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows XP
OS restrictions:	None
Author:	VBnet - Randy Birch

Related:	SetParent: Add a VB Progress Bar to a VB StatusBar Pure VB: Customizable PhotoShop-Style ProgressBar Pure VB: Customizable PhotoShop-Style ProgressBar in a MDI App CreateWindowEx: Creating a Common Control ProgressBar- Overview CreateWindowEx: Creating the Common Control Flood Panel via the API SetParent: Display Modal Form Activity on a Parent Form's 'PhotoShop-style' ProgressBar SetParent: Display Modal Form Activity in a Parent Form's VB ProgressBar

Prerequisites

None. This method works against both the Visual Basic 5 and Visual Basic 6 Common Control progress bar.

Here's a quick SendMessage method to change the bar and / or back colours of both a VB5 or VB6 progress bar, or an API-created progress bar. Note that on XP, using the 'Silver' theme, the default bar colour is grey, not the usual blue.

BAS Module Code

None.

Form Code

To a new form add four progress bars (ProgressBar1 - ProgressBar4), three command buttons (Command1 - Command3), a common dialog control (CommonDialog1), and the following code:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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

Comments

PayPal Link