Curvare il testo in una DrawingArea

Da Gambas-it.org - Wikipedia.

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
 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
 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
 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
   .Center
   .W = Screen.AvailableWidth
   .H = Screen.AvailableHeight
   .Arrangement = Arrange.Fill
 End With
 
 With DrawingArea1 = New DrawingArea(Me) As "DrawingArea1"
   .X = 0
   .Y = 0
 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
 End With
 
End


Note

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