文字サイズの算出

Windows １０（１７０９）＋Visual Basic 2017 にてプログラムを作成しております。

現在、文字列を円弧に沿って表示しようと考えております。実際の対象は特殊なものですがＤＶＤなどの円形のメディアに表示させるような感じです。

Ｗｏｒｄのワードアートの文字効果の様にできれば最高なんですが処理イメージが全くわきませんので、文字列を分解して一文字ずつ表示しようと考えています。

文字の表示に関して、まず各文字のサイズと表示位置を算出したいのですが、

各文字のサイズは以前にご教授いただいた、MeasureString を利用しておりますが一文字ずつのサイズがうまく取得できずに以下の方法で取得しました。iAlenB ではかなりサイズが大きくなりましたしたので、苦肉の策で iAlenA （”あ”のサイズ）を算出しました。

        Dim iAiuLen As Integer = g.MeasureString("あいう", fFont, 0, sf).Width
        Dim iAlenA As Integer = iAiuLen - g.MeasureString("いう", fFont, 0, sf).Width
        Dim iAlenB As Integer = g.MeasureString("あ", fFont, 0, sf).Widt

その後、iAlenA を利用して位置をピタゴラスの定理を利用して Ｙ位置を求め表示を行いますが、指定したＸ位置と実際の文字左辺（ドットのデータ？）が離れているので連続して表示しても間隔が少し空いてしまいます。
そこで、以下の様に文字の表示位置を確認してみました。

        g.DrawString("あ", MyFont, MyBrush, X, Y)
        g.DrawRectangle(MyPen, X, Y, 1, 1)

表示された点と文字の左辺が上手く揃っていません。
カーニング？して表示できないかと考えており、実際の画面に表示される文字のサイズが得られればＸ位置を調整すればと考えました。

そこで、実際に画面に表示される文字のサイズ（レターフェイス？ボディーフェイス？）を取得する方法があればご教授ください。

以上、よろしくお願いいたします。

ＰＳ。
表示の際には StringAlignment.Near を指定してみましたがうまくいきませんでした。

> 間隔が少し空いてしまいます。

これでしょうか。MeasureString に StringFormat.GenericTypographic を指定するか、
MeasureCharacterRanges を使うと良いようです。
https://dobon.net/vb/dotnet/graphics/measurestring.html


高 DPI 環境では、下記の点にも注意してください。
https://qiita.com/felis_silv/items/efee4b1a397b0b95100a

Imports System.Drawing.Drawing2D

Imports System.Drawing.Text

Public Class Form1

  Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint

　　e.Graphics.TextRenderingHint = TextRenderingHint.AntiAlias

　　e.Graphics.SmoothingMode = SmoothingMode.HighQuality

　　e.Graphics.PixelOffsetMode = PixelOffsetMode.HighQuality



    Using linePen As New Pen(Color.FromArgb(128, Color.Red), 5)

      Dim lineText = "サンプル文字列 sample string"



      Dim line = (New PointF(20, 20), New PointF(200, 200))

　　　e.Graphics.DrawString(lineText, Me.Font, Brushes.Lime, 0, line.Item1, line.Item2, False)

　　　e.Graphics.DrawString(lineText, Me.Font, Brushes.Blue, 0, line.Item1, line.Item2, True)

　　　e.Graphics.DrawLine(linePen, line.Item1, line.Item2)



      Using gPath As New GraphicsPath()

　　　　gPath.StartFigure()

　　　　gPath.AddArc(New Rectangle(150, 20, 150, 150), 180, 180)



　　　　e.Graphics.DrawString(lineText, Me.Font, Brushes.Lime, gPath, False)

　　　　e.Graphics.DrawString(lineText, Me.Font, Brushes.Blue, gPath, True)

　　　　e.Graphics.DrawPath(linePen, gPath)

      End Using

    End Using

  End Sub

End Class



Public Module GraphicsExtensions

　<System.Runtime.CompilerServices.Extension()> _

  Public Function MeasureStringWithSpace(g As Graphics, txt As String, f As Font) As SizeF

    Dim sz = g.MeasureString(txt, f, PointF.Empty, StringFormat.GenericTypographic)

　　sz.Width += f.Size * (txt.Length - txt.Trim().Length)

    Return sz

  End Function



　<System.Runtime.CompilerServices.Extension>

  Public Sub DrawString(g As Graphics, txt As String, f As Font, b As Brush, _

        path As GraphicsPath, above As Boolean)

    Dim p = DirectCast(path.Clone(), GraphicsPath)

　　p.Flatten()

    Dim pos As (i As Integer, p As PointF) = (0, p.PathPoints(0))

    For iTo = 1 To p.PointCount - 1

　　　pos = g.DrawString(txt, f, b, pos.i, pos.p, p.PathPoints(iTo), above)

      If pos.i >= txt.Length Then

        Return

      End If

    Next

  End Sub



　<System.Runtime.CompilerServices.Extension()> _

  Public Function DrawString(g As Graphics, txt As String, f As Font, b As Brush, _

        iFrom As Integer, pFrom As PointF, pTo As PointF, above As Boolean _

        ) As (iNext As Integer, pNext As PointF)

    Dim state = g.Save()



　　'補正距離 

    Dim dx = CDbl(pTo.X - pFrom.X)

    Dim dy = CDbl(pTo.Y - pFrom.Y)

    Dim distance = (dx * dx + dy * dy) ^ 0.5

　　dx /= distance

　　dy /= distance



　　'文字列の切り出し 

    Dim iTo = iFrom

    Dim iLength = txt.Length

    Do Until iTo >= iLength

      Dim measure = txt.Substring(iFrom, iTo - iFrom + 1)

      If CSng(g.MeasureStringWithSpace(measure, f).Width) > distance Then

　　　　iTo -= 1

        Exit Do

      Else

　　　　iTo += 1

      End If

    Loop

    If iTo < iFrom Then

      Return (iFrom, pFrom)

    ElseIf iLength <= iTo Then

　　　iTo = iLength - 1

    End If

    Dim outText = txt.Substring(iFrom, iTo - iFrom + 1)

    Dim outSize = g.MeasureStringWithSpace(outText, f)



　　'回転と移動 

    If above Then

　　　'文字の高さ分だけ上方向にずらす 

　　　g.TranslateTransform(0, -outSize.Height, MatrixOrder.Append)

    End If

　　g.RotateTransform(CSng(180.0 * Math.Atan2(dy, dx) / Math.PI), MatrixOrder.Append)

　　g.TranslateTransform(pFrom.X, pFrom.Y, MatrixOrder.Append)



　　'文字列描画 

　　g.DrawString(outText, f, b, PointF.Empty)



　　g.Restore(state)



　　'次の描画位置 

    Return (iTo + 1, New PointF( _

      CSng(pFrom.X + dx * outSize.Width), _

      CSng(pFrom.Y + dy * outSize.Width)))

  End Function

End Module

円弧に沿って文字を描画したりワードアートのような描画という点について、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

デバッグしている間に魔界の仮面弁士さんとかぶってしまったようです。
私が難しいと書いた関数が見事に記述されていますね。数式部分は私には理解できません。

魔界の仮面弁士 さま、るきお さま、ご回答ありがとうございます。

るきお さま、サンプルをありがとうございます。
現在、サンプル内の条件を色々と変更して結果を確認しています。
中央が凸になる表示は問題なく行えました。今後は凹になるように条件を変えてみたいと思います。また、行列が扱え、グラフィックにも応用できるとは驚きました。

魔界の仮面弁士 さま、文字幅の取得とサンプルをありがとうございました。

文字幅の算出は一文字ずつ行えるのでややこしくなく助かります。
サンプルに関しては、Value Tuple に関してのエラーが出るので解決に至っていません。
検索してみると、Ｎｕｇｅｔを追加するか（ケンタッキー・フライド・チキンで注文するようにはいかないようです）、．ＮＥＴの４．７以降が必要とのこと（他ＰＣとの関連もあるので躊躇しています）

二つのサンプルを参考にプログラムを作成していきたいと思います。

また、DrawPath の便利さを実感できました。

今後ともよろしくお願いいたします。

また、ＮＵＧＥＴ や ．ＮＥＴ 関連もお時間があればご教授いただければ幸いです。

実行結果のイメージ




> ．ＮＥＴの４．７以降が必要とのこと（他ＰＣとの関連もあるので躊躇しています）
どのバージョンの .NET Framework を使う予定でしょうか?


> Ｎｕｇｅｔを追加するか（ケンタッキー・フライド・チキンで注文するようにはいかないようです）
nuget 「を」追加するのではなく、
nuget 「で」追加するのです。

① プロジェクトは、コンパイルが通る状態にしておきます。(新規プロジェクトでも可)
② [ツール]メニューから nuget パッケージマネージャーを起動
③ [参照]タブをクリックし、検索ボックスに "System.ValueTuple" と入力
④ 選択してインストール

ちなみに原理的には、同等品を自作すればより低いバージョンの .NET Framework でもコンパイルを通せるかと思います。
ValueTuple 構造体 と TupleElementNames 属性を自作すれば .NET 3.5 まで。
ExtensionAttribute 属性も自作すれば、.NET 2.0 までは下げられるかと。


> サンプルに関しては、Value Tuple に関してのエラーが出るので解決に至っていません。
戻り値を 2 個渡したかっただけなので、タプルを使わずに
「自作構造体」や「As Object()」に差し替えてやれば、
VB2008 + .NET 3.5 でもコンパイルできますよ。

たとえば
　'Public Function DrawString(…) As (iNext As Integer, pNext As PointF)
　Public Function DrawString(…) As Object()
にして
　'Return (iFrom, pFrom)
　Return New Object() {iFrom, pFrom}
とか。戻り値を受け取っている場所なども同様に修正します。

魔界の仮面弁士 さま、追加情報と画像のサンプルのご提示ありがとうございました。

追加情報より、使用経験のある構造体（Structure）を利用してみるとうまく表示できました。
とりあえず構造体を利用して様々なケースを試したあと、その他の方法も試してみようと思います。

今後ともよろしくお願いいたします。

ＰＳ．使用している.NET は 4.6.1　です。Nuget は 「参照」までは到達したのですが、名前がわからないのと(system....で探していました)、またライセンスについて色々と記載があったので諦めました。

> 追加情報と画像のサンプルのご提示ありがとうございました。
ワードアートと違って、急激なカーブへの対応は含まれていないので、あくまでも参考という事で…。

また、私のコードは数文字ずつ切り出して GraphicsPath に隣接描画する方法で、
るきおさんのは、文字列を GraphicsPath に変換してからパス全体を円形に歪める方法ですね。

前者だと、文字列の分割によってカーニングに問題が出ますし、
後者は変形によってフォントに歪みが生じることになります。

> 各文字のサイズと表示位置を算出したいのですが、
端点と中点の問題もあったりします。これについては、MSDN Magazine 2008年12月号の
「基礎　WPF でパス上にテキストをレンダリングする」
の記事で、美しくレンダリングするための技法が解説されています。
https://msdn.microsoft.com/ja-jp/magazine/ee310108.aspx
(VB + WinForms ではなく C# + WPF なので、そのまま適用できるものではないですが)


> 使用している.NET は 4.6.1　です。
であれば System.ValueTuple のかわりに System.Tuple が使えます。（.NET 4.0 以降）
これなら追加のライブラリも不要です。

'Dim line = (New PointF(20, 20), New PointF(200, 200))
Dim line = Tuple.Create(New PointF(20, 20), New PointF(200, 200))


'Dim pos As (i As Integer, p As PointF) = (0, p.PathPoints(0))
Dim pos = Tuple.Create(0, p.PathPoints(0))
'pos = g.DrawString(txt, f, b, pos.i, pos.p, p.PathPoints(iTo), above)
pos = g.DrawString(txt, f, b, pos.Item1, pos.Item2, p.PathPoints(iTo), above)


'Public Function DrawString(…) As (iNext As Integer, pNext As PointF)
Public Function DrawString(…) As Tuple(Of Integer, PointF)
'Return (iFrom, pFrom)
Return Tuple.Create(iFrom, pFrom)



> またライセンスについて色々と記載があったので諦めました。
System.ValueTuple ですよね。MIT ライセンスなので、比較的緩いですよ。

System.ValueTuple 自体はオープンソースですが、
再利用はオープンソースかどうかを問わず認められています。
https://wisdommingle.com/mit-license/

似たようなライセンス形態としては、Ms-PL ライセンスと言うものがあります。
https://blogs.msdn.microsoft.com/shintak/2012/09/08/microsoft-public-license-ms-pl/

ライセンス話のついでに書いておくと、.NET Framework のソースコードは
下記で公開されており、こちらは非常に制限の強い Ms-RSL ライセンスとなっています。
（ソースコードの参照のみが許可されている）
https://referencesource.microsoft.com/

魔界の仮面弁士 さま、フォローの情報をありがとうございました。

所用で頂戴した情報を活用できませんでした。
るきお さまの情報も併せて目的達成に努めたいと思います。

今後は文字のセンタリングと円の底に沿った文字の描画にチャレンジしてゆきたいと考えております。

色々とアドバイスを頂戴するかもしれませんがよろしくお願いいたします。

魔界の仮面弁士 さま、色々と情報をご提示ありがとうございました。
一応の解決に至りましたので、ここで状況をご報告させていただきます。

１）文字のセンタリングは全文字のサイズから描画開始位置を修正することで解決できました。

２）円の底に沿った描画は、円の描画が右回りになるので文字列が反転してしまうので、サンプル画像の2つ目を参考に gpath.AddCurve() にて反転を回避しました。

３）一部、文字フォントと文字数によっては、以下の distance の値がゼロになるようで Atan2() の計算時に NaN というエラーが発生しましたので、 distance に Double.MinValue を代入しました。
　　     '補正距離 
        Dim dx = CDbl(pTo.X - pFrom.X)
        Dim dy = CDbl(pTo.Y - pFrom.Y)
        Dim distance = (dx * dx + dy * dy) ^ 0.5
        dx /= distance
        dy /= distance
　　　　　　：
         CSng(180.0 * Math.Atan2(dy, dx) / Math.PI)

４）半角空白（スペース）のサイズが大きくなるので調整するようにしました。
　　文字列に特定の文字を付加し、付加前のサイズとの差分を利用

以上、今後ともよろしくお願いいたします。

  

> ２）円の底に沿った描画は、円の描画が右回りになるので文字列が反転してしまうので、

もしかして、円弧の始点を 0度の位置にしていませんか?

私のコードで言う所の
　gPath.AddArc(New Rectangle(150, 20, 150, 150), 180, 180)
をコメントアウトし、かわりに
　gPath.AddArc(New Rectangle(150, 20, 150, 150), -180, -180)
あるいは、
　gPath.AddArc(New Rectangle(150, 20, 150, 150), 180, -180)
に変更すれば、反転せずに出力されるのではないでしょうか。


引数の意味は次の通り。

'始⌢終 

' 

'開始位置=+180度(9時方向)、円弧角=+180度(右回りに半周) 

gPath.AddArc(myRectangle, 180.0F, 180.0F)



'始⌣終 

' 

'開始位置=+180度(9時方向)、円弧角=-180度(左回りに半周) 

gPath.AddArc(myRectangle, 180.0F, -180.0F)





'終⌢始　　… 文字が上下反転します 

' 

'開始位置=0度(3時方向)、円弧角=-180度(左回りに半周) 

gPath.AddArc(New Rectangle(150, 20, 150, 150), 0.0F, -180.0F)



'終⌣始　　… 文字が上下反転します 

' 

'開始位置=+0度(3時方向)、円弧角=180度(右回りに半周) 

gPath.AddArc(New Rectangle(150, 20, 150, 150), 0.0F, 180.0F)

魔界の仮面弁士 さま、描画に関するご指摘をありがとうございました。

指定すべき開始位置や円弧角の引数に負の値を指定できるとは考えていませんでした。
円弧の描画だけの結果を見ただけでは知りえなかったかもしれません。

ご教授いただいた内容を利用することにより面倒な円弧パスの作成を省くことができ、すっきりしたコードになりました。文字反転も積極的に利用できることもできようになりました。

また、 distance がゼロになる状態も現状は発生していません。 

今後ともよろしくお願いいたします。