Curvare il testo in una DrawingArea

Il caso è quello in cui si scrive un testo su una circonferenza ideale curvando ogni carattere in modo tale che il proprio asse verticale converga al centro di detta circonferenza. ^{[Nota 1]}
La rotazione è data dai valori presenti nei metodi "Paint.Traslate()" e "Paint.Rotate()" relativi alle misure dell'area di disegno e a quelle del testo.

Nell'esempio, che segue, si scriveranno alcuni caratteri lungo il semicerchio superiore della circonferenza:

Public Sub Form_Open()
 
 Dim DrawingArea1 As DrawingArea
 
 With Me
   .Center
   .W = 600
   .H = 500
   .Arrangement = Arrange.Fill
 End With
 
 With DrawingArea1 = New DrawingArea(Me) As "DrawingArea1"
   .X = 0
   .Y = 0
 End With
  
End


Public Sub DrawingArea1_Draw()

 Dim car As Byte[] = [65, 66, 67, 68, 69, 70, 71, 72]   ' Imposta i caratteri da disegnare:
 Dim b As Byte

 With Paint
   .Arc(300, 300, 50, Rad(0), 360, False)
   .Stroke
   .DrawRect(250, 250, 50, 50, Color.Red, 1.0)
   .DrawRect(300, 250, 50, 50, Color.Red, 1.0)
   .DrawRect(250, 300, 50, 50, Color.Red, 1.0)
   .DrawRect(300, 300, 50, 50, Color.Red, 1.0)

   .Translate(240, 304)
   .Rotate(Rad(90))
   .DrawText(Chr(car[0]), 0, 0, .TextExtents(Chr(car[b])).W, .TextExtents(Chr(car[b])).H, Align.Normal)

   For b = 1 To car.Max
    .Translate(44, 14)
    .Rotate(Rad(315))
    .DrawText(Chr(car[b]), 0, 0, .TextExtents(Chr(car[b])).W, .TextExtents(Chr(car[b])).H, Align.Normal)
   Next 
End With
 
End

oppure ravvicinando i caratteri:

Public Sub DrawingArea1_Draw()

 Dim car As Byte[] = [65, 66, 67, 68, 69, 70, 71, 72]   ' Imposta i caratteri da disegnare:
 Dim b As Byte

 With Paint
   .Arc(300, 300, 50, Rad(0), 360, False)
   .Stroke
   .DrawRect(250, 250, 50, 50, Color.Red, 1.0)
   .DrawRect(300, 250, 50, 50, Color.Red, 1.0)
   .DrawRect(250, 300, 50, 50, Color.Red, 1.0)
   .DrawRect(300, 300, 50, 50, Color.Red, 1.0)

   .Translate(240, 304)
   .Rotate(Rad(90))
   .DrawText(Chr(car[0]), 0, 0, .TextExtents(Chr(car[b])).W, .TextExtents(Chr(car[b])).H, Align.Normal)

   For b = 1 To car.Max
     .Translate(14, 1)
     .Rotate(Rad(346.8))
     .DrawText(Chr(car[b]), 0, 0, .TextExtents(Chr(car[b])).W, .TextExtents(Chr(car[b])).H, Align.Normal)
   Next
 End With

End

e ancora di più:

Public Sub DrawingArea1_Draw()

 Dim car As Byte[] = [65, 66, 67, 68, 69, 70, 71, 72]   ' Imposta i caratteri da disegnare:
 Dim b As Byte

 With Paint
   .Arc(300, 300, 50, Rad(0), 360, False)
   .Stroke
   .DrawRect(250, 250, 50, 50, Color.Red, 1.0)
   .DrawRect(300, 250, 50, 50, Color.Red, 1.0)
   .DrawRect(250, 300, 50, 50, Color.Red, 1.0)
   .DrawRect(300, 300, 50, 50, Color.Red, 1.0)

   .Translate(240, 304)
   .Rotate(Rad(90))
   .DrawText(Chr(car[0]), 0, 0, .TextExtents(Chr(car[b])).W, .TextExtents(Chr(car[b])).H, Align.Normal)

   For b = 1 To car.Max
     .Translate(11.5, 0.6)
     .Rotate(Rad(348.8))
     .DrawText(Chr(car[b]), 0, 0, .TextExtents(Chr(car[b])).W, .TextExtents(Chr(car[b])).H, Align.Normal)
   Next
 End With

End

In quest'altro esempio, nel quale si consentirà di disegnare anche i caratteri speciali (come le lettere accentate):

Public Sub Form_Open()
 
 Dim DrawingArea1 As DrawingArea
 
 With Me
   .Move(0, 0, Screen.AvailableWidth, Screen.AvailableHeight)
   .Arrangement = Arrange.Fill
 End With

End


Public Sub DrawingArea1_Draw()
 
 Dim b As Byte
 Dim s As String
' L'uso di questo carattere (linea verticale) può essere utile per calibrare l'asse degli altri tipi di carattere:
 Dim testo As String = String(36, String.Chr(&239F))

 With Paint
' Imposta la posizione del primo carattere del testo da disegnare ruotato:
   .Translate(Me.W / 2.5, Me.H / 1.5)
   .Rotate(Rad(160))
   .Font.Size = 18
   .Brush = .Color(Color.Red)
   s = String.Mid(testo, 1, 1)
   .DrawText(s, 0, 0, .Font.TextWidth(s), .Font.TextHeight(s), Align.Center)
  
' Imposta la posizione dei restanti caratteri del testo da disegnare ruotato:
   For b = 1 To 24
' Aumentando un argomento, bisognerà ridurre l'altro empiricamente, e viceversa, per orientare l'asse verticale dei caratteri verso il centro del cerchio formato dal testo ruotato: 
     .Translate(20.0, 1.5)
' Aumentando questo valore, il cerchio del testo si allarga sino a diventare a 360° una linea dritta: 
     .Rotate(Rad(350))
     .Font.Size = 18
     .Brush = .Color(Color.Red)
     s = String.Mid(testo, b, 1)
     .DrawText(s, 0, 0, .Font.TextWidth(s), .Font.TextHeight(s), Align.Center)
   Next
 End With

End

Usando la trigonometria

Private DrawingArea1 As DrawingArea
Private imgLetters As Image[]                 ' Conterrà le lettere A–H come immagini individuali 
Private Const ImageSize As Integer = 40       ' Larghezza e altezza delle immagini contenenti le lettere 
Private Const CircleRadius As Integer = 100   ' raggio del cerchio
Private Const OffsetVert As Integer = 15      ' Correzione radiale per lettere verticali, per posizionarle tangenti
Private Const OffsetOriz As Integer = 15      ' Correzione radiale per lettere orizzontali, per posizionarle tangenti


Public Sub Form_Open()

 With Me
   .Arrangement = Arrange.Fill
   .Move(0, 0, Screen.AvailableWidth, Screen.AvailableHeight)
 End With

 DrawingArea1 = New DrawingArea(Me) As "DrawingArea1"

' Inizializza immagini lettere:
 imgLetters = New Image[]
 Dim letters As String[] = ["A", "B", "C", "D", "E", "F", "G", "H"]
 Dim colors As Integer[] = [Color.Red, Color.Blue, Color.Green, Color.Magenta, Color.Orange, Color.Purple, Color.DarkGray, Color.Black]

' Crea e memorizza un'immagine per ciascuna lettera:
 For i As Integer = 0 To letters.Max
   imgLetters.Add(CreateLetterImage(letters[i], colors[i]))
 Next

End


Public Sub DrawingArea1_Draw()

' Calcola le coordinate del centro del cerchio:
 Dim centerX As Float = DrawingArea1.W / 2
 Dim centerY As Float = DrawingArea1.H / 2

' Angoli (in gradi) per disporre 8 lettere equamente sul cerchio:
 Dim angles As Float[] = [0, 45, 90, 135, 180, 225, 270, 315]

 With Paint
' Disegna il cerchio al centro della DrawingArea:
   .Circle(centerX, centerY, CircleRadius)
   .Stroke
' Cicla su tutte le immagini delle lettere, disegnandole con l’angolo corrispondente, convertito in radianti con Rad():
   For i As Integer = 0 To imgLetters.Max
     DrawLetterAtAngle(centerX, centerY, CircleRadius, Rad(angles[i]), imgLetters[i], i)
   Next
 End With


' Funzione che crea una Image contenente la lettera specificata, colorata e centrata
Private Function CreateLetterImage(letter As String, letterColor As Integer) As Image

' Crea una nuova immagine vuota e trasparente:
 Dim img As New Image(ImageSize, ImageSize, Color.Transparent)

' Imposta font, colore e disegna la lettera centrata nell'immagine.
' Il valore -5 regola verticalmente la posizione per una resa più precisa.
 Paint.Begin(img)
   Paint.Font = Font["Ubuntu,20"]
   Paint.Brush = Paint.Color(letterColor)
   Paint.Text(letter, 0, -5, ImageSize, ImageSize, Align.Center)
   Paint.Fill
 Paint.End

 Return img

End


' Funzione che disegna un'immagine su un punto del cerchio, alla giusta distanza, ruotandola
Private Sub DrawLetterAtAngle(cx As Float, cy As Float, r As Float, angle As Float, img As Image, index As Integer)

 Dim w As Float = img.Width
 Dim h As Float = img.Height

' Calcola la distanza iniziale dal centro (raggio del cerchio + metà larghezza dell’immagine):
 Dim dist As Float = r + (w / 2)

' Aggiusta la distanza in base alla direzione della lettera: verticale (B, D) o orizzontale (A, C), oppure diagonale (E, F, G, H):
 If Abs(angle - Pi / 2) < 0.01 Or Abs(angle - 3 * Pi / 2) < 0.01 Then
   dist = dist - OffsetBD
 Else If Abs(angle) < 0.01 Or Abs(angle - Pi) < 0.01 Then
   dist = dist - OffsetAC
 Else
   dist = dist - 10
 End If

' Fine-tuning per compensare lievi differenze visive:
 Select Case index
   Case 1, 3, 5
     dist = dist - 5   ' Avvicina B, D, F al cerchio
   Case 7
     dist = dist + 5   ' Allontana H leggermente
 End Select

' Calcola le coordinate finali dove piazzare l'immagine:
 Dim tx As Float = cx + dist * Cos(angle)
 Dim ty As Float = cy + dist * Sin(angle)

' Ruota ogni immagine per tenerla perpendicolare alla tangente della circonferenza:
 Dim rotation As Float = angle + Pi / 2

' Ruota alcune lettere per orientarle correttamente lungo l’asse orizzontale:
 If Abs(angle) < 0.01 Or Abs(angle - Pi) < 0.01 Then
   rotation = rotation + Pi
 End If

' Rotazioni personalizzate per le lettere non simmetriche, per migliorarne l’orientamento estetico:
 Select Case index
   Case 1   ' B
     rotation = rotation + Pi / 2    ' 90° antiorario
   Case 3   ' D
     rotation = rotation - Pi / 2    ' 90° orario
   Case 5   ' F
     rotation = rotation + Pi / 2
   Case 7   ' H
     rotation = rotation + Pi / 2
 End Select

' Applica le trasformazioni, disegna l'immagine centrata e ripristina lo stato grafico:
 Paint.Save()
 Paint.Translate(tx, ty)
 Paint.Rotate(rotation)
 Paint.DrawImage(img, -w / 2, -h / 2)
 Paint.Restore()

End

Note

[1] Vedere anche questa pagina: Curvare la linea di testo in un oggetto Image