vb.netwinformsgraphics

How to draw rounded joints (concave and convex) in a PictureBox?

I'm trying to set up a progressbar with a picturebox, it has 4 colors and has rounded corners and centers. I've already managed to set up the picturebox with the colors and rounded corners, but I can't make the center.

This is an example of what I'm trying to reproduce:

example of what I'm trying to reproduce

This is what I've already managed to do:

this is what I've already managed to do

This is the code that I'm using:

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    Dim pictureBox As New PictureBox()
    pictureBox.Size = New Size(280, 30)
    pictureBox.Location = New Point(10, 80)
    AddHandler pictureBox.Paint, AddressOf Me.PictureBox_Paint
    Me.Controls.Add(pictureBox)
End Sub

    Private Sub PictureBox_Paint(sender As Object, e As PaintEventArgs)
    Dim g As Graphics = e.Graphics
    g.SmoothingMode = SmoothingMode.AntiAlias ' Essencial para bordas suaves

    Dim pb As PictureBox = CType(sender, PictureBox)
    
    Dim area As Rectangle = pb.ClientRectangle
   
    Dim colors() As Color = {
        Color.FromArgb(85, 85, 135), 
        Color.FromArgb(217, 83, 79),  
        Color.FromArgb(240, 173, 78), 
        Color.FromArgb(91, 192, 222)  
    }
    Dim proportions() As Double = {0.25, 0.15, 0.35, 0.25}

    Dim totalWidth As Single = area.Width
    Dim totalHeight As Single = area.Height

    Dim cornerRadius As Single = CSng(Math.Min(totalWidth * 0.1, totalHeight / 2.0)) 
    If cornerRadius <= 0 Then cornerRadius = 1 

    Dim currentX As Single = area.X
    Dim numSegments As Integer = colors.Length

    
    For i As Integer = 0 To numSegments - 1
        Dim segmentWidth As Single
        If i = numSegments - 1 Then
            segmentWidth = (area.X + totalWidth) - currentX
        Else
            segmentWidth = CSng(totalWidth * proportions(i))
        End If

        If segmentWidth <= 0 Then Continue For

        Dim segmentRect As New RectangleF(currentX, area.Y, segmentWidth, totalHeight)

        Dim roundLeft As Boolean = (i = 0) 
        Dim roundRight As Boolean = (i = numSegments - 1) 

        Using segmentPath As GraphicsPath = CreateSegmentPath(segmentRect, cornerRadius, roundLeft, roundRight)
            Using segmentBrush As New SolidBrush(colors(i))
                g.FillPath(segmentBrush, segmentPath)
            End Using 
        End Using 

        currentX += segmentWidth
    Next
End Sub

Private Function CreateSegmentPath(rectF As RectangleF, radius As Single, makeLeftRound As Boolean, makeRightRound As Boolean) As GraphicsPath
    Dim path As New GraphicsPath()
    Dim diameter As Single = Math.Max(0, radius * 2) 

    If diameter > rectF.Width Then diameter = rectF.Width
    If diameter > rectF.Height Then diameter = rectF.Height
    radius = diameter / 2.0F 

    Dim Left As Single = rectF.Left
    Dim Top As Single = rectF.Top
    Dim Right As Single = rectF.Right
    Dim Bottom As Single = rectF.Bottom

    If radius <= 0 OrElse rectF.Width <= 0 OrElse rectF.Height <= 0 Then
        path.AddRectangle(rectF)
        Return path
    End If

    If makeLeftRound Then
        path.AddArc(Left, Top, diameter, diameter, 180, 90)
    Else
        ' Começa com uma linha reta no canto
        path.AddLine(Left, Top + radius, Left, Top) 
        path.AddLine(Left, Top, Left + radius, Top)
    End If

    path.AddLine(Left + radius, Top, Right - radius, Top)

    If makeRightRound Then
        path.AddArc(Right - diameter, Top, diameter, diameter, 270, 90)
    Else
        path.AddLine(Right - radius, Top, Right, Top) 
        path.AddLine(Right, Top, Right, Top + radius) 
    End If

    path.AddLine(Right, Top + radius, Right, Bottom - radius)

    If makeRightRound Then
        path.AddArc(Right - diameter, Bottom - diameter, diameter, diameter, 0, 90)
    Else
        path.AddLine(Right, Bottom - radius, Right, Bottom) ' Termina a linha direita
        path.AddLine(Right, Bottom, Right - radius, Bottom) ' Começa a linha inferior
    End If

    path.AddLine(Right - radius, Bottom, Left + radius, Bottom)

    If makeLeftRound Then
        path.AddArc(Left, Bottom - diameter, diameter, diameter, 90, 90)
    Else
        path.AddLine(Left + radius, Bottom, Left, Bottom) 
        path.AddLine(Left, Bottom, Left, Bottom - radius) 
    End If

    path.CloseFigure() 
    Return path
End Function

I appreciate any help to solve this issue

Update my code:

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim pictureBox As New PictureBox()
pictureBox.Size = New Size(280, 30)
pictureBox.Location = New Point(10, 80)
AddHandler pictureBox.Paint, AddressOf Me.PictureBox_Paint
Me.Controls.Add(pictureBox)

End Sub

Private Sub PictureBox_Paint(sender As Object, e As PaintEventArgs)
Dim g As Graphics = e.Graphics
g.SmoothingMode = SmoothingMode.AntiAlias

Dim pb As PictureBox = CType(sender, PictureBox)
Dim area As Rectangle = pb.ClientRectangle
Dim colors As New List(Of Color) From {
    Color.FromArgb(70, 71, 117), ' Produtivo
    Color.FromArgb(210, 50, 45), ' Não Produtivo
    Color.FromArgb(237, 156, 40), ' Atenção
    Color.FromArgb(91, 192, 222) ' Não Definido
}
Dim proportions As New List(Of Double) From {0.25, 0.15, 0.35, 0.25}

Dim totalWidth As Single = area.Width
Dim totalHeight As Single = area.Height
Dim cornerRadius As Single = CSng(Math.Min(totalWidth * 0.1, totalHeight / 2.0))
If cornerRadius <= 0 Then cornerRadius = 1

Dim currentX As Single = area.X
paths.Clear() ' Limpar a lista antes de adicionar novos caminhos

' Criar os caminhos para cada segmento
For i As Integer = 0 To colors.Count - 1
    Dim segmentWidth As Single = CSng(totalWidth * proportions(i))
    If segmentWidth <= 0 Then Continue For

    Dim segmentRect As New RectangleF(currentX, area.Y, segmentWidth, totalHeight)
    Dim roundLeft As Boolean = (i = 0)
    Dim roundRight As Boolean = (i = colors.Count - 1)

    Dim segmentPath As GraphicsPath = CreateSegmentPath(segmentRect, cornerRadius, roundLeft, roundRight)
    paths.Add(segmentPath)

    currentX += segmentWidth
Next

' Pintar os caminhos de trás para frente
For i As Integer = paths.Count - 1 To 0 Step -1
    Using segmentBrush As New SolidBrush(colors(i))
        g.FillPath(segmentBrush, paths(i))
    End Using
Next
End Sub

Private Function CreateSegmentPath(rectF As RectangleF, radius As Single, makeLeftRound As Boolean, makeRightRound As Boolean) As GraphicsPath
Dim path As New GraphicsPath()
Dim diameter As Single = Math.Max(0, radius * 2)

If diameter > rectF.Width Then diameter = rectF.Width
If diameter > rectF.Height Then diameter = rectF.Height
radius = diameter / 2.0F

Dim Left As Single = rectF.Left
Dim Top As Single = rectF.Top
Dim Right As Single = rectF.Right
Dim Bottom As Single = rectF.Bottom

If radius <= 0 OrElse rectF.Width <= 0 OrElse rectF.Height <= 0 Then
    path.AddRectangle(rectF)
    Return path
End If

' --- Construção do Caminho ---
' Canto Superior Esquerdo
If makeLeftRound Then
    path.AddArc(Left, Top, diameter, diameter, 180, 90)
Else
    ' Começa com uma linha reta no canto
    path.AddLine(Left, Top + radius, Left, Top) ' Garante o ponto inicial correto
    path.AddLine(Left, Top, Left + radius, Top)
End If

' Linha Superior (entre os cantos/arcos)
path.AddLine(Left + radius, Top, Right - radius, Top)

' Canto Superior Direito
If makeRightRound Then
    path.AddArc(Right - diameter, Top, diameter, diameter, 270, 90)
Else
    path.AddLine(Right - radius, Top, Right, Top) ' Termina a linha superior
    path.AddLine(Right, Top, Right, Top + radius) ' Começa a linha direita
End If

' Linha Direita (Vertical)
path.AddLine(Right, Top + radius, Right, Bottom - radius)

' Canto Inferior Direito
If makeRightRound Then
    path.AddArc(Right - diameter, Bottom - diameter, diameter, diameter, 0, 90)
Else
    path.AddLine(Right, Bottom - radius, Right, Bottom) ' Termina a linha direita
    path.AddLine(Right, Bottom, Right - radius, Bottom) ' Começa a linha inferior
End If

' Linha Inferior
path.AddLine(Right - radius, Bottom, Left + radius, Bottom)

' Canto Inferior Esquerdo
If makeLeftRound Then
    path.AddArc(Left, Bottom - diameter, diameter, diameter, 90, 90)
Else
    path.AddLine(Left + radius, Bottom, Left, Bottom) ' Termina a linha inferior
    path.AddLine(Left, Bottom, Left, Bottom - radius) ' Começa a linha esquerda (para fechar)
End If

path.CloseFigure() ' Fecha o caminho conectando a última linha ao início
Return path
End Function
Solution

  • Reverse the color array to fill the larger value segments first. The bluish color represents the largest segment and therefore it fills the entire area. The value of the goldish color represents 75% of the width (0.25 + 0.15 + 0.35). Drawing it over the first segment leaves 25% only from its area visible. And so on for the rest of the smaller segments.

    In the loop, you don't need to offset the locations. Simply, take from the area.Width the width of each segment to create a rectangle and pass it to the path method to create a rectangular path with all sides rounded.

    Here's a custom control.

    Public Class SegmentsProgressBar
    Inherits PictureBox

    <Flags()>
    Friend Enum Corner As Integer
        None = 0
        TopLeft = 1
        BottomLeft = 2
        TopRight = 4
        BottomRight = 8
        All = TopLeft Or BottomLeft Or TopRight Or BottomRight
    End Enum

    Sub New()
        ResizeRedraw = True
    End Sub

    Protected Overrides Sub OnPaint(e As PaintEventArgs)
        MyBase.OnPaint(e)

        Dim area As Rectangle = ClientRectangle
        Dim colors As Color() = {
            Color.FromArgb(91, 192, 222),
            Color.FromArgb(240, 173, 78),
            Color.FromArgb(217, 83, 79),
            Color.FromArgb(85, 85, 135)
        }
        Dim proportions As Single() = {1, 0.75, 0.4, 0.25}
        Dim cornerRadius As Single = Math.Max(1, CSng(Math.Min(area.Width * 0.1, area.Height / 2.0)))

        e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
        e.Graphics.PixelOffsetMode = PixelOffsetMode.Half

        For i As Integer = 0 To proportions.Length - 1
            Dim segmentWidth As Single = area.Width * proportions(i)
            If segmentWidth <= 0 Then Continue For
            Dim segmentRect As New RectangleF(area.X, area.Y, segmentWidth, area.Height)

            Using segmentPath As GraphicsPath = CreatePath(segmentRect, cornerRadius, Corner.All),
                  segmentBrush As New SolidBrush(colors(i))
                e.Graphics.FillPath(segmentBrush, segmentPath)
            End Using
        Next
    End Sub

    Private Function CreatePath(rectF As RectangleF, radius As Single, corners As Corner) As GraphicsPath
        Dim path As New GraphicsPath()
        Dim diameter As Single = Math.Max(0, radius * 2)

        If diameter > rectF.Width Then diameter = rectF.Width
        If diameter > rectF.Height Then diameter = rectF.Height

        radius = diameter / 2.0F

        Dim Left As Single = rectF.Left
        Dim Top As Single = rectF.Top
        Dim Right As Single = rectF.Right
        Dim Bottom As Single = rectF.Bottom

        If radius <= 0 OrElse corners = Corner.None Then
            path.AddRectangle(rectF)
            Return path
        End If

        If (corners And Corner.TopLeft) > 0 Then
            path.AddArc(Left, Top, diameter, diameter, 180, 90)
        Else
            path.AddLine(Left, Top, Left, Top)
        End If

        If (corners And Corner.TopRight) > 0 Then
            path.AddArc(Right - diameter, Top, diameter, diameter, 270, 90)
        Else
            path.AddLine(Right, Top, Right, Top)
        End If

        If (corners And Corner.BottomRight) > 0 Then
            path.AddArc(Right - diameter, Bottom - diameter, diameter, diameter, 0, 90)
        Else
            path.AddLine(Right, Bottom, Right, Bottom)
        End If

        If (corners And Corner.BottomLeft) > 0 Then
            path.AddArc(Left, Bottom - diameter, diameter, diameter, 90, 90)
        Else
            path.AddLine(Left, Bottom, Left, Bottom)
        End If

        path.CloseFigure()

        Return path
    End Function

End Class

    Rebuild, find the SegmentsProgressBar at the top of the Toolbox window, and drop an instance.

    SO79560824