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