ProgressBar Paint Event

[LanceSummers]

Hello; I have a form with a Progress Bar and am trying to trap a Paint Event to draw a string on top of it. BUT, the paint event is never generated even though pBar.Refresh is called.

Here is the code:

Public Class TestProgressBar
Private Sub bTest_Click(sender As Object, e As EventArgs) Handles bTest.Click
Dim ProgressIndex As Int32
Dim DelayIndex As Int32
Dim ProgressMax As Int32
Dim PercentNum As Double
Dim PercentNumber As String
Dim f As Font
Dim b As New SolidBrush(Color.Black)
Dim drawBrush As New SolidBrush(Color.Black)
f = lProgress.Font 'Label used to get a font from. Easy to change the label's font
pBar.BackColor = Color.FromArgb(0, 192, 192)
ProgressMax = 1000
pBar.Maximum = ProgressMax
pBar.Minimum = 1
ProgressIndex = 1
While (ProgressIndex <= ProgressMax)
pBar.Value = ProgressIndex
DelayIndex = 0
If ((ProgressIndex Mod 10) = 0) Then
PercentNum = (ProgressIndex * 1.0#) / (ProgressMax * 1.0#)
If (PercentNum < 0.9999#) Then
PercentNumber = "0" + Trim(Str(PercentNum)) + "%"
Else
PercentNumber = Trim(Str(PercentNum)) + "%"
End If
pbar.Refresh()
Call WriteToProgressBar(pBar, PercentNumber, f, b)
Else
'We only write the percentage every 10 index
End If
While (DelayIndex < 2000)
DelayIndex = DelayIndex + 1
Application.DoEvents()
End While
ProgressIndex = ProgressIndex + 1
Application.DoEvents()
End While
End Sub
Private Sub TextDraw(e As PaintEventArgs)
Dim fontObj As Font
Dim Index As Integer
Dim HStart As Double
Dim WStart As Double
Dim FSize As Double
Dim StringToWrite As String
StringToWrite = "This Is A Test"
fontObj = New System.Drawing.Font("Times", 10, FontStyle.Bold)
FSize = fontObj.Size
On Error Resume Next
HStart = pBar.Top + ((pBar.Height - fontObj.Height) / 2)
WStart = pBar.Left + ((pBar.Width - (StringToWrite.Length * fontObj.Size)) / 2)
e.Graphics.DrawString(StringToWrite, fontObj, Brushes.Chocolate, WStart, HStart + 15) '+15 so I can see part of it
pBar.SendToBack()

If (Err.Number = 0) Then
Index = 0
Else
Err.Clear()
End If
End Sub

'WriteToProgressBar does not work, No text is shown

Private Sub WriteToProgressBar(ByVal pbIn As ProgressBar, ByVal sTextToDraw As String, ByVal f As Font, ByVal b As Brush)

Dim CenterH As Integer
Dim CenterW As Integer
Try
Using g As Graphics = Me.CreateGraphics
'Check to see if text is to wide/tall
If sTextToDraw.Length * f.Size > pbIn.Width Or f.Height > pbIn.Height Then
Throw New ArgumentException("Text is to large for progress bar!")
Else
CenterW = (pbIn.Width / 2) - ((sTextToDraw.Length * f.Size) / 2)
CenterH = (pbIn.Height / 2) - (f.Size / 2)
g.DrawString(sTextToDraw, f, b, New Point(CenterW, CenterH))
End If
End Using
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub

Private Sub bQuit_Click(sender As Object, e As EventArgs) Handles bQuit.Click
End 'I know, should not use End but this is just a test routine
End Sub

'This routine does show text but since it is the form, the text is UNDER the pBar


Private Sub TestProgressBar_Load(sender As Object, e As EventArgs) Handles Me.Load
'Call TextDraw()
End Sub

'This routine is never called. The breakpoint at Call TextDraw(e) is never stopped at

Private Sub pBar_Paint(sender As Object, e As PaintEventArgs) Handles pBar.Paint
Call TextDraw(e)
End Sub
End Class

Continue reading...