none
ProgressBar Paint Event RRS feed

  • Question

  • 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

    Monday, November 5, 2018 8:28 AM

Answers

  • If I draw over by disabling the theme, it is displayed correctly for me (Windows 10) :

        <DllImport("Uxtheme.dll", SetLastError:=True)>
        Public Shared Function SetWindowTheme(ByVal hWnd As IntPtr, ByVal pszSubAppName As String, ByVal pszSubIdList As String) As Integer
        End Function
    
        Friend WithEvents Button1 As Button
        Friend WithEvents ProgressBar1 As ProgressBar
        Friend WithEvents Timer1 As Timer
    
        Dim nValue As Integer = 0
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            ProgressBar1 = New ProgressBar()
            ProgressBar1.Location = New Point(10, 10)
            ProgressBar1.Size = New System.Drawing.Size(260, 23)
            ProgressBar1.BackColor = System.Drawing.Color.Red
            ProgressBar1.ForeColor = System.Drawing.Color.LimeGreen
            ProgressBar1.Minimum = 0
            ProgressBar1.Maximum = 100
            SetWindowTheme(ProgressBar1.Handle, "", "")
            Me.Controls.Add(ProgressBar1)
    
            Button1 = New System.Windows.Forms.Button()
            Button1.Location = New System.Drawing.Point(100, 112)
            Button1.Name = "Button1"
            Button1.Size = New System.Drawing.Size(75, 23)
            Button1.TabIndex = 0
            Button1.Text = "Button1"
            Button1.UseVisualStyleBackColor = True
            Controls.Add(Me.Button1)      
        End Sub
    
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            Timer1 = New Timer With {.Interval = 100, .Enabled = True}
            nValue = ProgressBar1.Minimum       
        End Sub
    
        Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
            nValue += 1
            If (nValue > ProgressBar1.Maximum) Then
                Timer1.Stop()
            Else
                ProgressBar1.Value = nValue
                Dim sText As String = nValue.ToString
                Using g As Graphics = ProgressBar1.CreateGraphics()                '     
                    Dim font As Font = New Font("Arial", 12)
                    g.DrawString(nValue.ToString, font,
                    New SolidBrush(Color.Yellow),
                    New PointF(ProgressBar1.Width / 2 - (g.MeasureString(sText, font).Width / 2.0F),
                               ProgressBar1.Height / 2 - (g.MeasureString(sText, font).Height / 2.0F)))
                End Using
            End If
        End Sub


    • Marked as answer by LanceSummers Monday, November 5, 2018 4:17 PM
    Monday, November 5, 2018 11:47 AM
  • Castrorix31.  Your code gave me a HINT that worked for me.

    I changed g as Graphics = Me.CreateGraphics to g as Graphics = pBar.CreateGraphics.

    Here is the modified code that works (though the Text string blanks out a lot by the pBar value change.

    'Objects on Form:
    '   bTest     = button top start the progress bar test code
    '   bQuit     = button to exit the form
    '   pBar      = ProgressBar78
    '   pProgress = Label (Hidden) so that we can get the font and change it if needed
    Public Class TestProgressBar
        'This routine is the button event that starts our progress bar test routine
        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.DarkBlue)
            Dim drawBrush As New SolidBrush(Color.Black)
            f = lProgress.Font
            pBar.BackColor = Color.FromArgb(0, 192, 192)
            ProgressMax = 5000
            pBar.Maximum = ProgressMax
            pBar.Minimum = 1
            ProgressIndex = 1
            While (ProgressIndex <= ProgressMax)
                pBar.Value = ProgressIndex
                DelayIndex = 0
                If ((ProgressIndex Mod 10) = 0) Then
                    PercentNum = (ProgressIndex * 100.0#) / (ProgressMax * 1.0#)
                    If (PercentNum < 1.0) Then
                        PercentNumber = "0" + Trim(Str(PercentNum)) + "%"
                    Else
                        PercentNumber = Trim(Str(PercentNum)) + "%"
                    End If
                    Me.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
        'This routine will draw text in the middle of the progress bar (Hopefully)
        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)
            pBar.SendToBack()
            If (Err.Number = 0) Then
                Index = 0
            Else
                Err.Clear()
            End If
        End Sub
        'This is routine is now working with the pBar.CreateGraphics change
        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 = pBar.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.Height / 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
        'Quit Button event
        Private Sub bQuit_Click(sender As Object, e As EventArgs) Handles bQuit.Click
            End
        End Sub
        'This is suppose to be generated every time the progress bar is redrawn on the form
        'but it is not being done at this moment
        Private Sub pBar_Paint(sender As Object, e As PaintEventArgs) Handles pBar.Paint
            Call TextDraw(e)
        End Sub
    End Class


    • Edited by LanceSummers Monday, November 5, 2018 10:38 PM
    • Marked as answer by LanceSummers Monday, November 5, 2018 10:38 PM
    Monday, November 5, 2018 4:16 PM

All replies

  • Lance,

    I dont think one can draw on the progressbar itself, at least not easily.

    Show an image of what you want to make or a link to an image or web site.

    You normally put the progress bar on a form or something can you draw on the form instead?

    Describe more about what you want.

    I think you should just draw your own progress bar on a form. Then you can add whatever you like.


    https://social.msdn.microsoft.com/Forums/vstudio/en-US/439c585e-ecc2-4d25-9844-d7216d91470a/how-yo-make-this-style-prograssbar?forum=vbgeneral

    https://social.msdn.microsoft.com/Forums/vstudio/en-US/a44e4e46-332a-43f4-b98d-61f4cb8158c1/vb-my-progress-doesnt-update-until-the-second-iteration-and-not-on-the-first-despire?forum=vbgeneral

    Monday, November 5, 2018 10:30 AM
  • If I draw over by disabling the theme, it is displayed correctly for me (Windows 10) :

        <DllImport("Uxtheme.dll", SetLastError:=True)>
        Public Shared Function SetWindowTheme(ByVal hWnd As IntPtr, ByVal pszSubAppName As String, ByVal pszSubIdList As String) As Integer
        End Function
    
        Friend WithEvents Button1 As Button
        Friend WithEvents ProgressBar1 As ProgressBar
        Friend WithEvents Timer1 As Timer
    
        Dim nValue As Integer = 0
        Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            ProgressBar1 = New ProgressBar()
            ProgressBar1.Location = New Point(10, 10)
            ProgressBar1.Size = New System.Drawing.Size(260, 23)
            ProgressBar1.BackColor = System.Drawing.Color.Red
            ProgressBar1.ForeColor = System.Drawing.Color.LimeGreen
            ProgressBar1.Minimum = 0
            ProgressBar1.Maximum = 100
            SetWindowTheme(ProgressBar1.Handle, "", "")
            Me.Controls.Add(ProgressBar1)
    
            Button1 = New System.Windows.Forms.Button()
            Button1.Location = New System.Drawing.Point(100, 112)
            Button1.Name = "Button1"
            Button1.Size = New System.Drawing.Size(75, 23)
            Button1.TabIndex = 0
            Button1.Text = "Button1"
            Button1.UseVisualStyleBackColor = True
            Controls.Add(Me.Button1)      
        End Sub
    
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            Timer1 = New Timer With {.Interval = 100, .Enabled = True}
            nValue = ProgressBar1.Minimum       
        End Sub
    
        Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
            nValue += 1
            If (nValue > ProgressBar1.Maximum) Then
                Timer1.Stop()
            Else
                ProgressBar1.Value = nValue
                Dim sText As String = nValue.ToString
                Using g As Graphics = ProgressBar1.CreateGraphics()                '     
                    Dim font As Font = New Font("Arial", 12)
                    g.DrawString(nValue.ToString, font,
                    New SolidBrush(Color.Yellow),
                    New PointF(ProgressBar1.Width / 2 - (g.MeasureString(sText, font).Width / 2.0F),
                               ProgressBar1.Height / 2 - (g.MeasureString(sText, font).Height / 2.0F)))
                End Using
            End If
        End Sub


    • Marked as answer by LanceSummers Monday, November 5, 2018 4:17 PM
    Monday, November 5, 2018 11:47 AM
  • Castrorix31.  Your code gave me a HINT that worked for me.

    I changed g as Graphics = Me.CreateGraphics to g as Graphics = pBar.CreateGraphics.

    Here is the modified code that works (though the Text string blanks out a lot by the pBar value change.

    'Objects on Form:
    '   bTest     = button top start the progress bar test code
    '   bQuit     = button to exit the form
    '   pBar      = ProgressBar78
    '   pProgress = Label (Hidden) so that we can get the font and change it if needed
    Public Class TestProgressBar
        'This routine is the button event that starts our progress bar test routine
        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.DarkBlue)
            Dim drawBrush As New SolidBrush(Color.Black)
            f = lProgress.Font
            pBar.BackColor = Color.FromArgb(0, 192, 192)
            ProgressMax = 5000
            pBar.Maximum = ProgressMax
            pBar.Minimum = 1
            ProgressIndex = 1
            While (ProgressIndex <= ProgressMax)
                pBar.Value = ProgressIndex
                DelayIndex = 0
                If ((ProgressIndex Mod 10) = 0) Then
                    PercentNum = (ProgressIndex * 100.0#) / (ProgressMax * 1.0#)
                    If (PercentNum < 1.0) Then
                        PercentNumber = "0" + Trim(Str(PercentNum)) + "%"
                    Else
                        PercentNumber = Trim(Str(PercentNum)) + "%"
                    End If
                    Me.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
        'This routine will draw text in the middle of the progress bar (Hopefully)
        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)
            pBar.SendToBack()
            If (Err.Number = 0) Then
                Index = 0
            Else
                Err.Clear()
            End If
        End Sub
        'This is routine is now working with the pBar.CreateGraphics change
        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 = pBar.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.Height / 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
        'Quit Button event
        Private Sub bQuit_Click(sender As Object, e As EventArgs) Handles bQuit.Click
            End
        End Sub
        'This is suppose to be generated every time the progress bar is redrawn on the form
        'but it is not being done at this moment
        Private Sub pBar_Paint(sender As Object, e As PaintEventArgs) Handles pBar.Paint
            Call TextDraw(e)
        End Sub
    End Class


    • Edited by LanceSummers Monday, November 5, 2018 10:38 PM
    • Marked as answer by LanceSummers Monday, November 5, 2018 10:38 PM
    Monday, November 5, 2018 4:16 PM
  • "Here is the modified code that works (though the Text string blanks out a lot"

    Thats because the image is not persisted when using creategraphics in this way. Instead the image is only redrawn in the timer tick event and then gets erased eventually.

    Maybe put the drawing code in a sub and call it when you update and from the timer event.

    A progressbar is a control that is not really meant to be drawn on from vb and normally we dont need to for this type control. Just draw the number to the side etc. even use a label control for just a number.

    Monday, November 5, 2018 5:01 PM
  •  I realize this has been answered but,  figured I would throw in my PercentProgressBar example for Lance or future searchers.  8)

     First add the PercentProgressBar class to your project,  then Build the application.  Now you will see the PercentProgressBar control at the top of your toolbox,  in the Form Designer view.  You can add one to the form from there,  just like any other control.

    Imports System.Runtime.InteropServices
    
    Public Class Form1
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            PercentProgressBar1.Value = 0
            Timer1.Interval = 50
            Timer1.Start()
        End Sub
    
        Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
            PercentProgressBar1.Increment(1)
            If PercentProgressBar1.Value = PercentProgressBar1.Maximum Then Timer1.Stop()
        End Sub
    End Class
    
    
    Public Class PercentProgressBar
        Inherits ProgressBar
    
        <DllImport("uxtheme.dll", EntryPoint:="SetWindowTheme")>
        Private Shared Function SetWindowTheme(ByVal hwnd As IntPtr, <MarshalAs(UnmanagedType.LPWStr)> ByVal pszSubAppName As String, <MarshalAs(UnmanagedType.LPWStr)> ByVal pszSubIdList As String) As Integer
        End Function
    
        Public Sub New()
            Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.ResizeRedraw Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.UserPaint, True)
        End Sub
    
        Protected Overrides Sub OnHandleCreated(ByVal e As EventArgs)
            SetWindowTheme(Me.Handle, "", "")
            MyBase.OnHandleCreated(e)
        End Sub
    
        Protected Overrides Sub OnPaint(e As PaintEventArgs)
            ProgressBarRenderer.DrawHorizontalBar(e.Graphics, New Rectangle(0, 0, Me.Width, Me.Height))
            Dim ProgressWidth As Integer = CInt((Me.Width / (Me.Maximum - Me.Minimum)) * Me.Value)
            ProgressBarRenderer.DrawHorizontalChunks(e.Graphics, New Rectangle(0, 0, ProgressWidth, Me.Height))
            Dim ProgressPercent As Integer = CInt(((Me.Maximum - Me.Minimum) / 100) * Me.Value)
            TextRenderer.DrawText(e.Graphics, ProgressPercent.ToString & "%", SystemFonts.DefaultFont, New Rectangle(0, 2, Me.Width, Me.Height), Color.Black, TextFormatFlags.HorizontalCenter Or TextFormatFlags.VerticalCenter)
            MyBase.OnPaint(e)
        End Sub
    End Class
     

     Looks like this ....

     

     PS - You may also want to check out my Custom Colored ProgressBar (ProgressBarEx) example on the msdn code gallery. 


    If you say it can`t be done then i`ll try it

    • Edited by IronRazerz Monday, November 5, 2018 10:51 PM
    • Proposed as answer by LeonCS Thursday, November 8, 2018 8:15 AM
    Monday, November 5, 2018 9:33 PM
  •  Looks like this ....

    If you say it can`t be done then i`ll try it

    Well Laa Dee Daa!

    I mean Very Nice Razerz!

    :)

    Tuesday, November 6, 2018 11:13 AM