如何在PictureBox中绘制带凹凸圆角衔接的多色进度条

我用PictureBox制作一款包含4种颜色的进度条，需要实现两端圆角及中间凹凸圆角衔接效果。目前已完成颜色填充和两端圆角，但中间的凹凸圆角衔接还没实现。

效果展示 #

目标效果 #

当前实现效果 #

初始代码 #

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

更新后的代码 #

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

恳请各位提供帮助解决该问题。

内容的提问来源于stack exchange，提问作者Luiz