Curved text spacing

Question

I converted Simon's solution HERE to VB.Net code and it works great. However, when I "reverse the curve by removing the -180F when calculating rotationAngleDegrees, and in the 2 places where currentCharacterRadians is assigned, change the subtractions to additions and vice versa" the spacing is much wider and I can't figure out how to match the original spacing. Has anyone had success with this?

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

I reversed the text to display on top, but the spacing is wider than the bottom text. — Dano, Dec 10 '14 at 17:37
If you leave the -180F in there the characters are backwards. — Dano, Dec 10 '14 at 18:03
Anyway, my problem is with the spacing between letters. Everything else is good. — Dano, Dec 10 '14 at 18:04
I think what's throwing you off is that my code above is already reversed from the original code from the link I posted. Take a look at the C# code that Simon posted and you will see where the -180F is at work. — Dano, Dec 10 '14 at 18:29

γηράσκω δ' αεί πολλά διδασκόμε · Accepted Answer · 2014-12-20T22:49:20.557

What happens when you rotate by 180 degrees is better illustrated bellow:

enter image description here

The rectangle(path) is always rotated around its origin which is up-left corner. You need to do the new math your self if you want to do it properly.

EDIT

This is the code to draw normal and inversed text:

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

The main function is DrawTextCurved. inv is inverse, dir is direction(clockwise or anticlockwise) of text and backgroundColor the color behind the text.

An example is:

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)

enter image description here

And inversed

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)

enter image description here

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

And the test:

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)

enter image description here

Thank you for your answer, but it's the spacing between characters after reversing the text that I'm having a problem with. Also, I'm terrible with math which is why I'm asking for help. http://s1.postimg.org/qir1wxjx7/curved_text.png — Dano, Dec 12 '14 at 07:57
Thank you so much. That code is way over my head, I would have never figured it out. There's one thing I don't understand. I'm getting a white background around each character and would like it to be transparent. I tried changing Color.FromKnownColor(KnownColor.Control) to Color.FromKnownColor(KnownColor.Transparent), but it just makes the blocks bigger. Here's a pic...http://s21.postimg.org/geqgbtjgj/Test.png — Dano, Dec 17 '14 at 06:03
@Dano color.transparent doesn't work. Use the same color as the background(behind text) which I believe is black. Also change the line in `FindSizes()` function: `g.Clear(Color.FromArgb(240, 240, 240))` to `g.Clear(backgroundColor)` — γηράσκω δ' αεί πολλά διδασκόμε, Dec 17 '14 at 11:23
Thanks for all your help, this works much better. http://s30.postimg.org/7otgmb6jh/thanks.png — Dano, Dec 22 '14 at 09:59

Curved text spacing

1 Answers1