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

文字間隔の調整

普通に描画すると左になるのを右のように描画されるようにしたい

VとWの間隔はほんの少し近づけてWとAは大きく近づける

これを手動じゃなくてほとんど自動で

今のPixtack紫陽花では

文字と文字の間隔の指定は等間隔なので

WAがくっつく前にVWがくっついてしまう

 

 

四角枠は文字の描画に使われる範囲を表しているただの目安

2がVWAの3文字まとめて描画した場合

それ以外は個別に描画したものを手動で並べたもの

4は描画範囲同士をピッタリくっつけた状態

3が4から2に合わせて並べたもので移動距離は

Wが4の状態から左に14ピクセル、Aが左に28ピクセルになっている

5が目的の状態で隣の文字同士の間隔が1か2ピクセルくらいで

Wが左に16ピクセル、Aが左に40ピクセル

字間を1ピクセルに指定した時に5の状態で描画するにはどうしたらいいのか

文字が描かれている範囲を把握する必要がある

文字描画範囲の取得にはMeasureStringを使っているけど余白が入ってピッタリにはならない

MeasureCharacterRangesってのもあって使ってみたけどこれもピッタリにはならない

水色枠がMeasureString、赤枠がMeasureCharacterRanges

どちらもピッタリにはならないので今回の目的には使えない

 

実際に描画してピクセルに色が付いているかどうかを1個づつ調べていく

ってのは今のPixtack紫陽花の字間指定でも使っているけど、足りないのでもうちょっと何とかしたいってことで今回作ったテスト用のもの

 

1文字ごとに描画した場合の色の付いている上下左右それぞれの

一番外側の位置を表示だけ

Topが12なら上(0)から11ピクセルは空白(余白)ってことで

Bottomが41ってのは下から40ピクセルまでは空白

「V」なら実際に使われている描画範囲は41-12=29が高さで

Right-Leftで33-7=26が横幅

「W」は縦が41-12=29、横幅が44-9=35

 

あいうえお

これだとTopの位置がバラけているのがわかる

 

今回はじめて使ったのが構造体、Structureっていうのを使うやつ

' VB いろいろなクラス・構造体 - Module, Enum, Structure, Partial
'http://homepage1.nifty.com/rucio/main/dotnet/shokyu/standard50.htm

'構造体
Public Structure DrawLimit描画範囲
   '4つの整数をまとめただけの構造体、上下左右の数値
    Public Sub New(top As Integer, bottom As Integer, left As Integer, right As Integer)
        Me.Top = top
        Me.Bottom = bottom
        Me.Left = left
        Me.Right = right
    End Sub

    Public Property Top As Integer
    Public Property Bottom As Integer
    Public Property Left As Integer
    Public Property Right As Integer

    Public Overrides Function ToString() As String
        Dim str As String = "Top=" & Top & ", Bottom=" & Bottom & ", Left=" & Left & ", Right=" & Right
        Return str
    End Function
End Structure

4つの整数を入れておくだけのもの

上下左右の4つの数値をひとつにまとめて管理したくて構造体ってのに辿り着いたのはVB中学校でした

Overridesってのも使い慣れていなくてあんまりわかっていないけどToStringで意図した通りに返ってきている

Sub Newってのも初めて使ったかも

 

デザイン画面

PictureBox1、Button1、ListBox1

 

 

Button1のクリックイベント↑↓

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    Me.ListBox1.Items.Clear() 'リストボックスの初期化

   'Me.PictureBox1.Width = Me.Width
    Me.PictureBox1.Width = 256
    Me.PictureBox1.Height = 178
   'Me.PictureBox1.Width = 100
    Me.PictureBox1.Width = 400
   'Me.PictureBox1.Height = 50

    Dim str As String = "/Pixtackjylg紫陽花" '文字の指定
    str = "あいうえお"
   'str = "kjkx"
   'str = "VWA"
    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 drawLimit As New List(Of DrawLimit描画範囲) 'コレクション

   '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) '文字の描画
       'g.DrawString(str.Chars(i), font, b, Rectangle.Round(rectC), sf)

        drawLimit.Add(DrawRange描画範囲上下左右getPixel版(bmp)) '描画した画像から色のついたPixelを探して上下左右の一番外側をコレクションに追加
        Me.ListBox1.Items.Add(str.Chars(i) & " = " & drawLimit.Item(i).ToString) 'リストボックスに表示
    Next

    bmp = New Bitmap(w, h)
    g = Graphics.FromImage(bmp)
   'g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
    Dim rr As New Rectangle(rect.X, rect.Y, rect.Width - 1, rect.Height - 1) '赤枠描画用
    g.DrawRectangle(Pens.Red, rr) '赤枠描画
    g.DrawString(str, font, b, rect, sf) '文字列描画

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

End Sub

 

 

初めて使ってみたStructure

 

Public Structure DrawLimit描画範囲
   '4つの整数をまとめただけの構造体、上下左右の数値
    Public Sub New(top As Integer, bottom As Integer, left As Integer, right As Integer)
        Me.Top = top
        Me.Bottom = bottom
        Me.Left = left
        Me.Right = right
    End Sub
    Public Property Top As Integer
    Public Property Bottom As Integer
    Public Property Left As Integer
    Public Property Right As Integer
    Public Overrides Function ToString() As String
        Dim str As String = "Top=" & Top & ", Bottom=" & Bottom & ", Left=" & Left & ", Right=" & Right
        Return str
    End Function
End Structure

 

文字を描画した画像を受け取って上下左右の一番外側を返す

GetPixelを使っているから遅い

 

Private Function DrawRange描画範囲上下左右getPixel版(bmp As Bitmap) As DrawLimit描画範囲
    Dim w As Integer = bmp.Width
    Dim h As Integer = bmp.Height
    Dim topY, downY, leftX, rightX, x, y As Integer '上限、下限,左端、右端
    Dim isFind As Boolean = False '上限、下限見つかったよフラグ


   '上
    For y = 0 To h - 1
        For x = 0 To w - 1
            If bmp.GetPixel(x, y).A <> 0 Then
                isFind = True
                topY = y
                Exit For
            End If
        Next
        If isFind Then Exit For
    Next
    isFind = False

   '下の行から順番に色があるピクセルを探す
    For y = h - 1 To 0 Step -1
        For x = 0 To w - 1
            If bmp.GetPixel(x, y).A <> 0 Then
                isFind = True
                downY = y
                Exit For
            End If
        Next
        If isFind Then Exit For
    Next
    isFind = False

   '左端
    For x = 0 To w - 1
        For y = 0 To h - 1
            If bmp.GetPixel(x, y).A <> 0 Then
                isFind = True
                leftX = x
                Exit For
            End If
        Next
        If isFind Then Exit For
    Next
    isFind = False

   '右端探査
    For x = w - 1 To 0 Step -1
        For y = 0 To h - 1
            If bmp.GetPixel(x, y).A <> 0 Then
                isFind = True
                rightX = x
                Exit For
            End If
        Next
        If isFind Then Exit For
    Next

    Return New DrawLimit描画範囲(topY, downY, leftX, rightX)
End Function

 

 

またさっきの構造体で上下左右をリストボックスに表示したいからって

作った構造体でToStringをOverridesしなくても

Dim dl As New DrawLimit描画範囲(1, 1, 1, 1)

dl.

って書くと入力候補にToStringが出てくるから、できるじゃなーいって実行したら

コレジャナイ

ってことでToStringは出てくるんだからこれをオーバーライドっていうので

書き直せばいいんじゃないかってなって

 

ToStringをOverridesしている？ところ

 

        Public Overrides Function ToString() As String

            Dim str As String = "Top=" & Top & ", Bottom=" & Bottom & ", Left=" & Left & ", Right=" & Right

            Return str

        End Function

 

って書いたらうまく行ったわけ

「i」を見て思ったのは横幅は13-10=3じゃなくて13-10+1=4だなあ

縦も+1だな

 

今回はここまで、先は長いなあ

OneDrive 文字の描画位置、範囲_20150403.7z

VisualBasic2013 - OneDrive

ファイル名：文字の描画位置、範囲_20150403.7z

 

 

 

参照したところ

VB いろいろなクラス・構造体 - Module, Enum, Structure, Partial

http://homepage1.nifty.com/rucio/main/dotnet/shokyu/standard50.htm

 

文字列を描画したときの大きさを計測する: .NET Tips: C#, VB.NET

http://dobon.net/vb/dotnet/graphics/measurestring.html

 

 

次回は2日後

gogowaten.hatenablog.com