Create a Progress Bar using the API
Fed up with distributing the 509KB ComCtl32.ocx with your
program just for a single control? In this article, I
will demonstrate how to create a progress bar using the CreateWindowEx API call. Topics
such as horizontal and vertical bars, forecolour and backcolour and positioning the
progress bar will be covered.
As with the status bar, a lot of the information in this
article was extracted from the ComCtrl.h header file. This file is written in C++ syntax
and therefore you will need to know the basics of translating C++.
Just a quick note to let you know that all the project
files (a form, bas module, project and compiled exe) amount to a mere 4% of the
ComCtl32.ocx!
Add a new module (modProgBar) and copy the following code
into it:
Option Explicit
'// Windows API Declares
Public Declare Function CreateWindowEX Lib_
"user32" _
Alias "CreateWindowExA"_
(ByVal dwExStyle As Long, _
ByVal lpClassName As String, _
ByVal lpWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal hMenu As Long, _
ByVal hInstance As Long, lpParam As Any)_
As Long
Public Declare Function DestroyWindow Lib_
"user32" _
(ByVal hwnd As Long) As Long
Public Declare Function MoveWindow Lib "_
user32" _
(ByVal hwnd As Long, ByVal x As Long, _
ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal bRepaint As Long)_
As Long
Public Declare Function SetParent Lib_
"user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Public Declare Function SendMessage Lib_
"user32" _
Alias "SendMessageA"_
(ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam_
As Long, lParam As Any) As Long
'// Progess bar class name
Public Const PROGRESS_CLASS =_
"msctls_progress32"
'// Windows Messages and styles
Public Const WM_USER = &H400
Public Const WS_VISIBLE = &H10000000
Public Const WS_CHILD = &H40000000
'// Progress bar styles and messages
Public Const PBS_SMOOTH = &H1
Public Const PBS_VERTICAL = &H4
Public Const PBM_SETRANGE = (WM_USER + 1)
Public Const PBM_SETPOS = (WM_USER + 2)
Public Const PBM_DELTAPOS = (WM_USER + 3)
Public Const PBM_SETSTEP = (WM_USER + 4)
Public Const PBM_STEPIT = (WM_USER + 5)
Public Const PBM_SETRANGE32 = (WM_USER + 6)
Public Const PBM_GETRANGE = (WM_USER + 7)
Public Const PBM_GETPOS = (WM_USER + 8)
Public Const PBM_SETBARCOLOR = (WM_USER + 9)
'// Common Controls messages
Public Const CCM_FIRST = &H2000
Public Const CCM_SETBKCOLOR = (CCM_FIRST + 1)
Public Const SB_SETBKCOLOR = CCM_SETBKCOLOR
Add a new form (frmTest) and
add six command buttons (cmdBarColour, cmdBackColour, cmdDestroy,
cmdCreate, cmdCreateVert and cmdSetVal). Copy the following code into
the form:
Option Explicit
'// Stores the progress bars window handle
Private lnghWnd As Long
Private Sub cmdBackColour_Click()
'// Set the backcolour
SendMessage lnghWnd, SB_SETBKCOLOR, 0, ByVal RGB(255,255, 255)
End Sub
Private Sub cmdBarColour_Click()
'// Set the bar colour
SendMessage lnghWnd, PBM_SETBARCOLOR, 0, ByVal RGB(0,127, 0)
End Sub
Private Sub cmdDestroy_Click()
'// Destroy the progress bar
DestroyWindow lnghWnd
End Sub
Private Sub cmdCreate_Click()
'// Create a horizontal progress bar
CreateProgress False
End Sub
Private Sub cmdSetVal_Click()
'//Set the position to 50
SendMessage lnghWnd, PBM_SETPOS, 50, 0
End Sub
Private Sub cmdCreateVert_Click()
'// Create a vertical progress bar
CreateProgress True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'// Destroy the progress bar
DestroyWindow lnghWnd
End Sub
Sub CreateProgress(Vertical As Boolean)
Dim lngType As Long
Dim x As Long
Dim y As Long
Dim lngHeight As Long
Dim lngWidth As Long
If Vertical = True Then
'// Set the style to vertical
lngType = PBS_VERTICAL
x = 250
y = 25
lngHeight = 125
lngWidth = 20
Else
lngType = 0
x = 100
y = 125
lngHeight = 20
lngWidth = 125
End If
'// Create the progress bar
lnghWnd = CreateWindowEX(0, PROGRESS_CLASS,"", WS_VISIBLE _
Or WS_CHILD Or lngType, 0, 0, 0, 0, Me.hwnd, _
0&, App.hInstance, 0&)
'// Set the bar's parent
Call SetParent(lnghWnd, Me.hwnd)
'// Create another window
lnghWnd = CreateWindowEX(0, PROGRESS_CLASS,"", WS_VISIBLE _
Or WS_CHILD Or lngType, 0, 0, 0, 0, Me.hwnd, _
0&, App.hInstance, 0&)
'// Move it
MoveWindow lnghWnd, x, y, lngWidth, lngHeight, True
End Sub