Use GDI to put a Progress Bar in your command button... or any control
Need a progress bar and not sure where to put it?
how about on the command button that started the process :-)
or basically on any control with a handle.
Put this code into a form and place a command button on there.
Original Author: Michael Toye
Code
Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private mDC&, mBitmap&
Sub DrawProgressBar(dc&, X&, Y&, w&, h&, bc&, fc&, perc&)
SetPixel mDC, 0, 0, bc
StretchBlt dc, X, Y, w, h, mDC, 0, 0, 1, 1, vbSrcCopy
SetPixel mDC, 0, 0, fc
StretchBlt dc, X, Y, Int((w / 100) * perc) + 1, h, mDC, 0, 0, 1, 1, vbSrcCopy
End Sub
Sub CreateBitmap(w&, h&)
mDC = CreateCompatibleDC(GetDC(0))
mBitmap = CreateCompatibleBitmap(GetDC(0), w, h)
SelectObject mDC, mBitmap
SetBkMode mDC, 1
End Sub
Sub KillBitmap()
DeleteObject mBitmap
DeleteDC mDC
End Sub
Private Sub Command1_Click()
Dim dc&, l&
dc = GetDC(Command1.hwnd)
Command1.Enabled = False
For l = 1 To 100
DrawProgressBar dc, 7, (Command1.Height Screen.TwipsPerPixelY) - 8, (Command1.Width Screen.TwipsPerPixelX) - 14, 3, vbRed, vbGreen, l
Sleep 10: DoEvents
Next
Command1.Enabled = Not Command1.Enabled
End Sub
Private Sub Form_Load()
CreateBitmap 1, 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
KillBitmap
End Sub
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.