弯曲的文字间距

Question

我将Simon的解决方案HERE转换为VB.Net代码，效果很好。但是，当我通过在计算rotationAngleDegrees时移除-180F来反转曲线，并且在分配了currentCharacterRadians的2个位置时，将减法更改为加法，反之亦然＆＃34;间距要宽得多，我无法弄清楚如何匹配原始间距。有人有这个成功吗？

Private Sub DrawCurvedText(graphics As Graphics, text As String, centre As Point, distanceFromCentreToBaseOfText As Single, radiansToTextCentre As Single, font As Font, _
brush As Brush)
' Circumference for use later
Dim circleCircumference = CSng(Math.PI * 2 * distanceFromCentreToBaseOfText)

' Get the width of each character
Dim characterWidths = GetCharacterWidths(graphics, text, font).ToArray()

' The overall height of the string
Dim characterHeight = graphics.MeasureString(text, font).Height

Dim textLength = characterWidths.Sum()

' The string length above is the arc length we'll use for rendering the string. Work out the starting angle required to 
' centre the text across the radiansToTextCentre.
Dim fractionOfCircumference As Single = textLength / circleCircumference

Dim currentCharacterRadians As Single = radiansToTextCentre - CSng(Math.PI * fractionOfCircumference)

For characterIndex As Integer = 0 To text.Length - 1
    Dim [char] As Char = text(characterIndex)

    ' Polar to cartesian
    Dim x As Single = CSng(distanceFromCentreToBaseOfText * Math.Sin(currentCharacterRadians))
    Dim y As Single = -CSng(distanceFromCentreToBaseOfText * Math.Cos(currentCharacterRadians))

    Using characterPath As New GraphicsPath()
        characterPath.AddString([char].ToString(), font.FontFamily, CInt(font.Style), font.Size, Point.Empty, StringFormat.GenericTypographic)

        Dim pathBounds = characterPath.GetBounds()

        ' Transformation matrix to move the character to the correct location. 
        ' Note that all actions on the Matrix class are prepended, so we apply them in reverse.
        Dim transform = New Matrix()

        ' Translate to the final position
        transform.Translate(centre.X + x, centre.Y + y)

        ' Rotate the character
        Dim rotationAngleDegrees = currentCharacterRadians * 180F / CSng(Math.PI)
        transform.Rotate(rotationAngleDegrees)

        ' Translate the character so the centre of its base is over the origin
        transform.Translate(-pathBounds.Width / 2F, -characterHeight)

        characterPath.Transform(transform)

        ' Draw the character
        graphics.FillPath(brush, characterPath)
    End Using

    If characterIndex <> text.Length - 1 Then
        ' Move "currentCharacterRadians" on to the next character
        Dim distanceToNextChar = (characterWidths(characterIndex) + characterWidths(characterIndex + 1)) / 2F
        Dim charFractionOfCircumference As Single = distanceToNextChar / circleCircumference
        currentCharacterRadians += charFractionOfCircumference * CSng(2F * Math.PI)
    End If
Next
End Sub

Private Function GetCharacterWidths(graphics As Graphics, text As String, font As Font) As IEnumerable(Of Single)
' The length of a space. Necessary because a space measured using StringFormat.GenericTypographic has no width.
' We can't use StringFormat.GenericDefault for the characters themselves, as it adds unwanted spacing.
Dim spaceLength = graphics.MeasureString(" ", font, Point.Empty, StringFormat.GenericDefault).Width

Return text.[Select](Function(c) If(c = " "C, spaceLength, graphics.MeasureString(c.ToString(), font, Point.Empty, StringFormat.GenericTypographic).Width))
End Function

Answer 1

180 degrees 之后会发生什么情况更好地说明如下：

rectangle(path)始终围绕原点旋转，up-left角。 如果你想要正确地做，你需要自己做新的数学运算。

修改

这是绘制normal和inversed文字的代码：

Private lstSizes As List(Of Size) = New List(Of Size)
Private lstBmp As List(Of Bitmap) = New List(Of Bitmap)

Private Sub DrawTextCurved(ByVal txt As String, ByVal myfont As System.Drawing.Font, ByVal backgroundColor As Color, _
                         ByVal startAngle As Single, ByVal center As PointF, ByVal radius As Double, ByVal inv As Boolean, _
                         ByVal dir As Boolean, ByVal g As Graphics)
    Dim bmp As Bitmap
    Dim gBmp As Graphics
    Dim i, wdth As Integer
    Dim rad As Single = startAngle
    Dim phi As Single = startAngle
    Dim x, y, x1, y1 As Single
    Dim mat As Matrix = New Matrix


    wdth = FindSizes(txt, myfont, backgroundColor)

    bmp = New Bitmap(wdth, CInt(radius), Imaging.PixelFormat.Format32bppArgb)
    gBmp = Graphics.FromImage(bmp)

    For i = 0 To lstBmp.Count - 1
        gBmp.ResetTransform()
        gBmp.SmoothingMode = SmoothingMode.AntiAlias
        gBmp.Clear(Color.Transparent)

        If inv = True Then
            gBmp.TranslateTransform(CInt(CDbl(bmp.Width) / 2D - (CDbl(lstSizes(i).Width - 1) / 2D)), 1)
        Else
            gBmp.TranslateTransform(CInt(CDbl(bmp.Width) / 2D - (CDbl(lstSizes(i).Width - 1) / 2D)), bmp.Height - lstBmp(i).Height)
        End If

        gBmp.DrawImage(lstBmp(i), 0, 0)

        If inv = True Then
            mat.Translate(center.X - CSng(CDbl(bmp.Width) / 2D), center.Y - CSng(bmp.Height))
            mat.RotateAt(phi * 180.0F / CSng(Math.PI), New PointF(CSng(CDbl(bmp.Width) / 2D), CSng(bmp.Height)))
        Else
            x = CSng(Math.Cos(phi) * (CDbl(bmp.Width) / 2D + 1D))
            y = CSng(Math.Sin(phi) * (CDbl(bmp.Width) / 2D + 1D))

            mat.Translate(center.X - x, center.Y + y)
            mat.Rotate(-phi * 180.0F / CSng(Math.PI))
        End If

        g.Transform = mat

        g.DrawImage(bmp, 0, 0)

        If i = lstBmp.Count - 1 Then
            Exit For
        End If

        If dir = True Then 'anti-clockwise, normal
            phi += CSng(Math.Atan((CDbl(lstSizes(i).Width) / 2D) / CDbl(bmp.Height - lstBmp(i).Height)))

            phi += CSng(Math.Atan((CDbl(lstSizes(i + 1).Width) / 2D) / CDbl(bmp.Height - lstBmp(i + 1).Height)))
        Else
            phi -= CSng(Math.Atan((CDbl(lstSizes(i).Width) / 2D) / CDbl(bmp.Height - lstBmp(i).Height)))

            phi -= CSng(Math.Atan((CDbl(lstSizes(i + 1).Width) / 2D) / CDbl(bmp.Height - lstBmp(i + 1).Height)))
        End If


        mat.Reset()
    Next

    For i = 0 To lstBmp.Count - 1
        lstBmp(i).Dispose()
        lstBmp(i) = Nothing
    Next

    lstBmp.Clear()
    lstSizes.Clear()
End Sub 

Private Function FindSizes(ByVal txt As String, ByVal myfont As System.Drawing.Font, ByVal backgroundColor As Color) As Integer
    Dim g As Graphics
    Dim sz As SizeF
    Dim i, wdth, hgt, wdthMax, wdthS, hgtS As Integer
    Dim bmp As Bitmap = New Bitmap(10, 10, Imaging.PixelFormat.Format24bppRgb)
    Dim bmpS As Bitmap

    g = Graphics.FromImage(bmp)
    g.SmoothingMode = SmoothingMode.AntiAlias

    For i = 0 To txt.Length - 1
        sz = g.MeasureString(txt(i).ToString, myfont)

        If txt(i).ToString = " " Then
            wdthS = CInt(sz.Width)
            hgtS = CInt(sz.Height)
        End If

        If wdth < Math.Ceiling(sz.Width) Then
            wdth = CInt(Math.Ceiling(sz.Width))
        End If

        If hgt < Math.Ceiling(sz.Height) Then
            hgt = CInt(Math.Ceiling(sz.Height))
        End If
    Next

    bmp.Dispose()
    bmp = Nothing
    g.Dispose()

    bmpS = New Bitmap(wdthS, hgtS, Imaging.PixelFormat.Format24bppRgb)
    g = Graphics.FromImage(bmpS)
    g.Clear(backgroundColor)

    g.Dispose()

    bmp = New Bitmap(wdth, hgt, Imaging.PixelFormat.Format24bppRgb)
    g = Graphics.FromImage(bmp)
    g.SmoothingMode = SmoothingMode.AntiAlias

    For i = 0 To txt.Length - 1
        g.Clear(backgroundColor)

        g.DrawString(txt(i).ToString, myfont, Brushes.Red, New PointF(0.0F, 0.0F))

        If txt(i).ToString = " " Then
            lstBmp.Add(bmpS)
            lstSizes.Add(New Size(wdthS, hgtS))
            wdth = wdthS
        Else
            wdth = LockBitmap(bmp, backgroundColor)
        End If

        If wdthMax < wdth Then
            wdthMax = wdth
        End If
    Next

    g.Dispose()
    g = Nothing

    Return (wdthMax + 5) * 2
End Function

Private Function LockBitmap(ByVal bmp As Bitmap, ByVal backgroundColor As Color) As Integer
    Dim xmin, xmax, ymin, ymax As Integer
    Dim r, g, b As Byte
    Dim wdth As Integer = 0
    Dim gr As Graphics
    Dim first As Boolean = True
    Dim rect As Rectangle
    Dim bmpData As System.Drawing.Imaging.BitmapData

    rect = New Rectangle(0, 0, bmp.Width, bmp.Height)
    bmpData = bmp.LockBits(rect, _
        Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)

    For y = 0 To bmpData.Height - 1
        For x = 0 To bmpData.Width - 1
            b = Marshal.ReadByte(bmpData.Scan0, (bmpData.Stride * y) + (3 * x))
            g = Marshal.ReadByte(bmpData.Scan0, (bmpData.Stride * y) + (3 * x) + 1)
            r = Marshal.ReadByte(bmpData.Scan0, (bmpData.Stride * y) + (3 * x) + 2)

            If b <> backgroundColor.B Or g <> backgroundColor.G Or r <> backgroundColor.R Then
                If first = True Then
                    xmin = x
                    xmax = x
                    ymin = y
                    ymin = y

                    first = False
                Else
                    If x < xmin Then
                        xmin = x
                    End If

                    If x > xmax Then
                        xmax = x
                    End If

                    If y < ymin Then
                        ymin = y
                    End If

                    If y > ymax Then
                        ymax = y
                    End If
                End If

            End If
        Next
    Next

    bmp.UnlockBits(bmpData)

    If ((xmax - xmin + 1) Mod 2) = 0 Then 'even
        wdth = 1
    End If

    lstBmp.Add(New Bitmap(xmax - xmin + 1 + wdth, ymax - ymin + 1, Imaging.PixelFormat.Format24bppRgb))
    lstSizes.Add(New Size(xmax - xmin + 1 + wdth, ymax - ymin + 1))

    gr = Graphics.FromImage(lstBmp(lstBmp.Count - 1))
    'gr.SmoothingMode = SmoothingMode.AntiAlias


    gr.DrawImage(bmp, New Rectangle(0, 0, lstBmp(lstBmp.Count - 1).Width, lstBmp(lstBmp.Count - 1).Height), _
                  New Rectangle(xmin, ymin, lstBmp(lstBmp.Count - 1).Width - wdth, lstBmp(lstBmp.Count - 1).Height), GraphicsUnit.Pixel)


    gr.Dispose()
    gr = Nothing

    Return xmax - xmin + 1 + wdth
End Function

主要功能是DrawTextCurved。 inv是反向的，dir是文本的方向（顺时针或逆时针），backgroundColor是文本背后的颜色。

一个例子是：

Dim g As Graphics = Me.CreateGraphics
Dim myfont As System.Drawing.Font = New System.Drawing.Font("Arial", 14.0F)

DrawTextCurved("BOTTOM TEXT", myfont, Color.FromKnownColor(KnownColor.Control), -52.0F * CSng(Math.PI) / 180.0F, _
                 New PointF(140.0F, 140.0F), 80D, False, True, g)

反转

DrawTextCurved("TOP TEXT", myfont, Color.FromKnownColor(KnownColor.Control), -34.0F * CSng(Math.PI) / 180.0F, _
                 New PointF(140.0F, 140.0F), 80D, True, True, g)

<强> EDIT2

Private lstSizes As List(Of Size) = New List(Of Size)
Private lstOffset As List(Of Point) = New List(Of Point)

Private Sub DrawTextCurved(ByVal txt As String, ByVal myfont As System.Drawing.Font, _
                         ByVal startAngle As Single, ByVal center As PointF, ByVal radius As Single, ByVal inv As Boolean, _
                          ByVal g As Graphics)
    Dim mat As Matrix = New Matrix
    Dim phi As Single = startAngle 'degrees
    Dim rad As Single
    Dim i As Integer

    FindSizes(txt, myfont)

    rad = phi * CSng(Math.PI) / 180.0F 'degrees to rad

    For i = 0 To lstSizes.Count - 1

        If inv = True Then
            mat.Translate(center.X - CSng(lstSizes(i).Width) / 2.0F - lstOffset(i).X, center.Y - radius - CSng(lstSizes(i).Height) - lstOffset(i).Y)
            mat.RotateAt(phi, New PointF(CSng(lstSizes(i).Width) / 2.0F + lstOffset(i).X, radius + CSng(lstSizes(i).Height) + lstOffset(i).Y))
        Else
            mat.Translate(center.X - CSng(lstSizes(i).Width) / 2.0F - lstOffset(i).X, center.Y + radius - CSng(lstSizes(i).Height) - lstOffset(i).Y)
            mat.RotateAt(phi, New PointF(CSng(lstSizes(i).Width) / 2.0F + lstOffset(i).X, -radius + CSng(lstSizes(i).Height) + lstOffset(i).Y))

        End If

        g.Transform = mat
        g.DrawString(txt(i).ToString, myfont, Brushes.Red, New PointF(0.0F, 0.0F))

        If i = lstSizes.Count - 1 Then
            Exit For
        End If

        If inv = True Then
            rad += CSng(Math.Atan(CDbl(CSng(lstSizes(i).Width) / (radius * 2.0F))))
            rad += CSng(Math.Atan(CDbl(CSng(lstSizes(i + 1).Width) / (radius * 2.0F))))
        Else
            rad -= CSng(Math.Atan(CDbl(CSng(lstSizes(i).Width) / ((radius - CSng(lstSizes(i).Height) - lstOffset(i).Y) * 2.0F))))
            rad -= CSng(Math.Atan(CDbl(CSng(lstSizes(i + 1).Width) / ((radius - CSng(lstSizes(i + 1).Height) - lstOffset(i + 1).Y) * 2.0F))))
        End If

        phi = rad * 180.0F / CSng(Math.PI) 'rad to degrees

        mat.Reset()
    Next

    mat.Reset()
    g.ResetTransform()

    lstOffset.Clear()
    lstSizes.Clear()
End Sub

Private Sub FindSizes(ByVal txt As String, ByVal myfont As System.Drawing.Font)
    Dim g As Graphics
    Dim sz As SizeF
    Dim i, wdth, hgt, wdthS, hgtS As Integer
    Dim bmp As Bitmap = New Bitmap(10, 10, Imaging.PixelFormat.Format24bppRgb)

    g = Graphics.FromImage(bmp)
    g.SmoothingMode = SmoothingMode.AntiAlias

    For i = 0 To txt.Length - 1
        sz = g.MeasureString(txt(i).ToString, myfont)

        If txt(i).ToString = " " Then
            wdthS = CInt(sz.Width)
            hgtS = CInt(sz.Height)
        End If

        If wdth < Math.Ceiling(sz.Width) Then
            wdth = CInt(Math.Ceiling(sz.Width))
        End If

        If hgt < Math.Ceiling(sz.Height) Then
            hgt = CInt(Math.Ceiling(sz.Height))
        End If
    Next

    bmp.Dispose()
    bmp = Nothing
    g.Dispose()
    g = Nothing

    bmp = New Bitmap(wdth, hgt, Imaging.PixelFormat.Format24bppRgb)
    g = Graphics.FromImage(bmp)
    g.SmoothingMode = SmoothingMode.AntiAlias

    For i = 0 To txt.Length - 1
        g.Clear(Color.FromArgb(240, 240, 240))

        g.DrawString(txt(i).ToString, myfont, Brushes.Red, New PointF(0.0F, 0.0F))

        If txt(i).ToString = " " Then
            lstSizes.Add(New Size(wdthS, hgtS))
            lstOffset.Add(New Point(0, 0))
            wdth = wdthS
        Else
            LockBitmap(bmp, Color.FromArgb(240, 240, 240))
        End If

    Next

    g.Dispose()
    g = Nothing
End Sub

Private Sub LockBitmap(ByVal bmp As Bitmap, ByVal backgroundColor As Color)
    Dim xmin, xmax, ymin, ymax As Integer
    Dim r, g, b As Byte
    Dim wdth As Integer = 0
    Dim first As Boolean = True
    Dim rect As Rectangle
    Dim bmpData As System.Drawing.Imaging.BitmapData

    rect = New Rectangle(0, 0, bmp.Width, bmp.Height)
    bmpData = bmp.LockBits(rect, _
        Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)

    For y = 0 To bmpData.Height - 1
        For x = 0 To bmpData.Width - 1
            b = Marshal.ReadByte(bmpData.Scan0, (bmpData.Stride * y) + (3 * x))
            g = Marshal.ReadByte(bmpData.Scan0, (bmpData.Stride * y) + (3 * x) + 1)
            r = Marshal.ReadByte(bmpData.Scan0, (bmpData.Stride * y) + (3 * x) + 2)

            If b <> backgroundColor.B Or g <> backgroundColor.G Or r <> backgroundColor.R Then
                If first = True Then
                    xmin = x
                    xmax = x
                    ymin = y
                    ymin = y

                    first = False
                Else
                    If x < xmin Then
                        xmin = x
                    End If

                    If x > xmax Then
                        xmax = x
                    End If

                    If y < ymin Then
                        ymin = y
                    End If

                    If y > ymax Then
                        ymax = y
                    End If
                End If

            End If
        Next
    Next

    ' Unlock the bits.
    bmp.UnlockBits(bmpData)

    lstSizes.Add(New Size(xmax - xmin + 1, ymax - ymin + 1))
    lstOffset.Add(New Point(xmin, ymin))
End Sub

测试：

DrawTextCurved("TOP TEXT", myfont, -30.0F, New PointF(120, 120), 90.0F, True, g)
DrawTextCurved("BOTTOM TEXT", myfont, 57.0F, New PointF(120, 120), 90.0F, False, g) 
g.DrawEllipse(Pens.Black, 120 - 90, 120 - 90, 180, 180)