初めて使ってみたStructure、構造体、文字の描画の文字間隔の調整その3の下

さっきの

続き

Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
    Me.ListBox1.Items.Clear() 'リストボックスの初期化
    Me.ListBox1.Anchor = AnchorStyles.Top Or AnchorStyles.Left Or AnchorStyles.Right
    Me.PictureBox1.Height = 178
    Me.PictureBox1.Width = 400
    Dim str As String = "Pixtack紫陽花" '文字の指定
   'str = "あいうえお"
    str = "ターン"
   'str = "VWA"
   'str = "ソノ人"
    Dim w As Integer = Me.PictureBox1.Width
    Dim h As Integer = Me.PictureBox1.Height
    Dim bmp As New Bitmap(w, h)
    Dim g As Graphics = Graphics.FromImage(bmp)
   'g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
    Dim b As New SolidBrush(Color.Black)
    Dim font As New Font("Meiryo UI", 30, FontStyle.Regular)
    Dim rect As New Rectangle(New Point(0, 0), New Size(w, h))
    Dim sf As New StringFormat()
    Dim sizeCanvas As SizeF = g.MeasureString(str, font, New PointF(0, 0), sf)
    Dim rectC As New RectangleF(New PointF(0, 0), sizeCanvas)
    Dim wRectF As RectangleF '1文字の描画範囲用
    Dim wRect As Rectangle
    Dim drawRange As New List(Of DrawRange2描画範囲) 'コレクション
    Dim bmpList As New List(Of Bitmap) '文字画像コレクション
    Const WORD_SPACE As Integer = 1 '指定マージン

   '1文字ごとに描画してDrawRange描画範囲上下左右getPixel版に渡して上下左右を取得してDrawLimit描画範囲のリストに追加しつつリストボックスに表示
   '描画位置の情報集め
    For i As Integer = 0 To str.Length - 1
        bmp = New Bitmap(w, h)
        g = Graphics.FromImage(bmp)
       'g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias'アンチエイリアス
       'g.DrawString(str.Chars(i), font, b, Rectangle.Ceiling(rectC), sf) '文字の描画
        wRectF = New RectangleF(New PointF(0, 0), g.MeasureString(str.Chars(i), font, New PointF(0, 0), sf)) '描画範囲
        wRect = Rectangle.Round(wRectF) 'RectangleFからRectangleにRoundで変換、Ceilingの方がいい？
        bmp = New Bitmap(wRect.Width + 1, wRect.Height + 1) 'Bitmap作り直し、＋1は必要？
        g = Graphics.FromImage(bmp) 'Graphicsも作り直し
        g.DrawString(str.Chars(i), font, b, wRect, sf) '文字描画
        drawRange.Add(DrawRange2描画範囲情報(bmp)) '描画した画像から色のついたPixelを探して上下左右の一番外側をコレクションに追加
        Me.ListBox1.Items.Add(str.Chars(i) & " = " & drawRange.Item(i).myString1()) 'リストボックスに表示
        bmpList.Add(bmp) '描画した画像をコレクションに追加

    Next

   'リストボックス表示用
    For i = 0 To str.Length - 1
        Me.ListBox1.Items.Add(str.Chars(i) & " = " & drawRange.Item(i).myString2()) 'リストボックスに項目追加、
        Dim RY As String = str.Chars(i) & "_RightY = "
        Dim LY As String = "LeftY = "
        For j As Integer = 0 To drawRange(i).RightY.Count - 1
            RY &= drawRange(i).RightY(j) & ", "
        Next
        For j = 0 To drawRange(i).LeftY.Count - 1
            LY &= drawRange(i).LeftY(j) & ", "
        Next
        Me.ListBox1.Items.Add(RY & LY)
    Next

   '描画位置の情報を元にして全部の文字を描画
    bmp = New Bitmap(w, h)
    g = Graphics.FromImage(bmp)
    Dim drawPoint2 As New Point(-drawRange(0).LeftX + WORD_SPACE, 0)
    g.DrawString(str.Chars(0), font, b, drawPoint2, sf) '最初の1文字目の描画
    Dim dSize As SizeF = g.MeasureString(str.Chars(0), font, New PointF(0, 0), sf)
    Dim rRect As New Rectangle(Point.Round(drawPoint2), dSize.ToSize())
   'g.DrawRectangle(Pens.Red, rRect)

   'E:\オレ\エクセル\VisualBasicでアプリ作成2.xlsm_文字_$A$494
    For i = 1 To str.Length - 1 '2文字目以降の描画
       '描画のx座標
        dSize = g.MeasureString(str.Chars(i), font, New PointF(0, 0), sf)
        Dim word2左空間 As Integer = LeftSpace指定座標の距離一覧(bmpList(i), drawRange(i - 1)).Left '一つ前の文字の右端と同じ高さにある今から描画する文字の左空間
        Dim w1RAndW2L As Integer = drawRange(i - 1).RightSpace + word2左空間 '一つ前の文字の右空間＋一つ前の文字の右空間と同じ高さの今から描画する文字の左空間
        Dim word1右空間 As Integer = LeftSpace指定座標の距離一覧(bmpList(i - 1), drawRange(i)).Right '今から描画する文字の左端と同じ高さにある一個前の文字の右空間
        Dim w1LAndw2R As Integer = drawRange(i).LeftX + word1右空間
        Dim wordSpace As Integer = Math.Min(w1LAndw2R, w1RAndW2L) '小さい方、距離が短い方
        drawPoint2.X = drawPoint2.X + drawRange(i - 1).AllSize.Width - wordSpace + WORD_SPACE '描画座標
        g.DrawString(str.Chars(i), font, b, drawPoint2, sf) '文字の描画
        rRect = New Rectangle(drawPoint2, dSize.ToSize()) '枠の描画用
       'g.DrawRectangle(Pens.Red, rRect) '枠の描画

    Next

    Me.PictureBox1.Image = bmp
    g.Dispose()
    b.Dispose()
    sf.Dispose()
End Sub