Use GDI to put a Progress Bar in your command button... or any control

Posted: 2003-06-01
By: ArchiveBot
Viewed: 127

Filed Under:

Visual Basic 6

No attachments for this post

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

Comments on this post

No comments have been added for this post.

You must be logged in to make a comment.