Изогнутый текстовый интервал

Question

Я преобразовал решение Simon HERE в код VB.Net, и он отлично работает. Однако, когда я «отменяю кривую, удаляя -180F при вычислении rotationAngleDegrees, а в 2 местах, где назначаются текущие CharacterRadians, измените вычитания на дополнения и наоборот», интервал намного шире, и я не могу понять, как соответствуют исходному интервалу. Кто-нибудь имел успех в этом?

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 угол. Вам нужно сделать новую математику самостоятельно, если вы хотите сделать это правильно.

EDIT

Это код рисовать 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)