投稿者 るきお  (社会人) 投稿日時 2018/4/7 22:27:04
円弧に沿って文字を描画したりワードアートのような描画という点について、GraphicsPathクラスは描画ポイントの座標をすべて記録しているので、元の座標(x1, y1)を変換したい座標(x2, y2)に変換する数学的な関数がわかれば自由な変換が実現可能です。

けれど、この関数が難しく、高等数学の知識がなければ自由にデザインすることが難しいです。回転や平行移動など一次変換で対応できる基本的なものであればあらかじめ用意されているのですが。

下記の例は参考に円弧に沿って文字を描画するものです。Transform関数のForループの中が(x1, y1)→(x2, y2)の変換に相当する部分で、この部分を変えれば自由な変換ができます。

この関数は私が試行錯誤して作ってみたものでできはよくないかもしれませんが、よろしければ参考にしてください。



それから、参考になりそうなサイトもあったので紹介します。(私はよく見ていません)
https://www.codeproject.com/Articles/13864/Text-on-Path-with-VB-NET


Option Strict On

Imports System.Drawing.Drawing2D

Public Class Form1

    Private Sub PictureBox1_Paint(sender As Object, e As PaintEventArgs) Handles PictureBox1.Paint

        '▼「あいうえお」を円形に歪める。 
        Dim path As New GraphicsPath()

        path.AddString("あいうえお"Me.Font.FontFamily, 0, 100, New Point(0, 0), StringFormat.GenericDefault)
        path.AddEllipse(195, 195, 10, 10)
        path = Transform(path, 1000, New PointF(200, 200))

        e.Graphics.FillPath(Brushes.Orange, path)
        e.Graphics.DrawPath(Pens.Red, path)

        '▼参考に円形に歪めない「あいうえお」 
        Dim path2 As New GraphicsPath
        path2.AddString("あいうえお"Me.Font.FontFamily, 0, 100, New Point(0, 0), StringFormat.GenericDefault)

        e.Graphics.DrawPath(Pens.Blue, path2)

        '▼円の中心点を黒丸で示す 
        e.Graphics.FillEllipse(Brushes.Black, 195, 195, 10, 10)


    End Sub


    ''' <summary> 
    ''' GraphicsPathの内容を円形に歪めます。 
    ''' </summary> 
    ''' <param name="path">対象のGraphicsPath</param> 
    ''' <param name="width">360度に相当する横幅。幅1000のものを360度に歪めるのか、幅2000のものを360度に歪めるのかという値。</param> 
    ''' <param name="center">円の中心点</param> 
    ''' <returns></returns> 
    Private Function Transform(path As GraphicsPath, width As Integer, center As PointF) As GraphicsPath

        Dim points() As PointF = path.PathPoints

        For i As Integer = 0 To points.Length - 1
            Dim p As PointF = path.PathPoints(i)
            Dim x1 As Single = p.X
            Dim y1 As Single = p.Y

            'X座標と中心点の距離が大きいほどより大きく回転させる。距離がwidthと等しい点は360度回転させる。 
            Dim offsetX As Single = x1 - center.X
            Dim degTheta As Single = (offsetX / width) * 360

            '点centerを中心にdegTheta度回転する行列を作成 
            Dim mat As New Matrix
            mat.RotateAt(degTheta, center)

            Dim newPoint() As PointF = {New PointF(center.X, y1)}
            mat.TransformPoints(newPoint)

            points(i) = newPoint(0)

        Next

        Return New GraphicsPath(points, path.PathTypes)

    End Function

End Class