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

初めて使ってみたStructure、構造体、文字の描画の文字間隔の調整 ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ

http://blogs.yahoo.co.jp/gogowaten/12893033.html

gogowaten.hatenablog.com

前回の続き

取得した描画範囲を元にして描画するところまで進んだ

文字間(マージン)を1に指定した場合で描画

VWAを描画、今回の結果

 

下のリストボックスにある文字列は1文字ごと普通に描画した時の描画範囲情報

Top、Left、Bottom、Rightがって文字で説明するの難しいから図で↓

左上を基点(0)にして文字の上下左右の一番外側にある(色が付いている)ピクセルの座標みたいなもの

 

TopCountとかCountが付いているのが

それぞれのライン上にあるピクセル数

今回の描画には関係ないけど後で使うかも

 

描画位置(DrawPoint.X)の決定の計算

最初の1文字目「V」の横座標は左の空白を削るだけなので元の座標－Left、元の座標は0なので0-7＝-7、指定マージンが1なので1足して6

2文字目からは

描画座標 ＝ 前回の描画座標 ＋ 一個前の文字の幅 ＋ 一個前の文字の左空白 － 描画文字の左空白 ＋ 指定マージン

「W」の描画座標 = -6 + 27 + 7 - 9 + 1＝20

 

iiiをマージン指定1

 

iiiをマージン指定0

あいうえおをマージン指定0

「う」と「え」が離れている感じがする

 

「ソノ人」でマージン指定0

文字の形が四角形じゃないとマージン0にしても離れている感じがするのは

上下左右っていう単純な四角形で判定しているから

ソとノだとソの右上とノの左下がマージンの判定になっているけど

ノの左端に当たる左下のY座標と同じY座標にあるソはかなり離れている

ソの右端に当たる右上のY座標と同じY座標にあるノもかなり離れている

これを近づけるには

前の文字に近づけていって最初に重なる座標から計算かなあ

ってことで必要になりそうなライン上のピクセルの座標を持たせるように作りなおしたDrawRange描画範囲っていう構造体が↓

 

 Public Structure DrawRange描画範囲

    Public Property TopX As List(Of Integer)
    Public Property TopY As Integer
    Public Property BottomX As List(Of Integer)
    Public Property BottomY As Integer
    Public Property LeftX As Integer
    Public Property LeftY As List(Of Integer)
    Public Property RightX As Integer
    Public Property RightY As List(Of Integer)

    Public Overrides Function ToString() As String
        Dim str As String
        str = "TopY=" & TopY & " BottomY=" & BottomY & " LeftX=" & LeftX & " RightX=" & RightX &
            " TopX_Count=" & TopX.Count & " BottomX_Count=" & BottomX.Count & " LeftY_Count=" & LeftY.Count & " RightY_Count=" & RightY.Count
        Return str
    End Function

End Structure

 

 

新しく使ってみたのが

Public Property TopX As List(Of Integer)

っていうところ

プロパティの変数にList(Of Integer)っていうリスト(コレクション？)型のinteger型を使ってみた

 

「V」の時だとTopXには図のTopCountのラインにある色のついたピクセルのX座標の入れ物になる

「V」を描画したときのDrawRange描画範囲の中の様子

TopXに8個の数字が入っている、これがTopのライン上にある色付きのピクセルのすべてのX座標で、Y座標はTopYになるので組み合わせれば一番上側の座標一覧ができる

 

最初できなかったのが

List(Of Integer)をNewして作るタイミング

構造体の中でNewしたらエラーになるので

 

実際に構造体を使うときにNewしたら使えるようになった

理解していないから使い方間違っていそうだけど期待通りに動いている

DrawRange描画範囲っていう構造体作ったけど構造体じゃなくてクラスで作ったほうがいいのかもとか

Public Propertyでいろいろ作ったけどDimでよかったんじゃないかとか

List(Of Integer)で作ったけど普通の配列でもよかったんじゃないかとか

 

Public Structure DrawRange描画範囲
    Public Property TopX As List(Of Integer)
    Public Property TopY As Integer
    Public Property BottomX As List(Of Integer)
    Public Property BottomY As Integer
    Public Property LeftX As Integer
    Public Property LeftY As List(Of Integer)
    Public Property RightX As Integer
    Public Property RightY As List(Of Integer)

    Public Overrides Function ToString() As String
        Dim str As String
       'str = "TopY=" & TopY & " TopX_Count=" & TopX.Count &
       '   " BottomY=" & BottomY & " BottomX_Count=" & BottomX.Count &
       '   " LeftX=" & LeftX & " LeftY_Count=" & LeftY.Count &
       '   " RightX=" & RightX & " RightY_Count=" & RightY.Count
        str = "TopY=" & TopY & " BottomY=" & BottomY & " LeftX=" & LeftX & " RightX=" & RightX &
            " TopX_Count=" & TopX.Count & " BottomX_Count=" & BottomX.Count & " LeftY_Count=" & LeftY.Count & " RightY_Count=" & RightY.Count
        Return str
    End Function

    Public Function myString1() As String 'ToStringのかわり、上下左右の一番外側の位置
        Dim str As String = "TopY=" & TopY & " BottomY=" & BottomY & " LeftX=" & LeftX & " RightX=" & RightX & " Width=" & RightX - LeftX + 1 & " Height=" & BottomY - TopY + 1
        Return str
    End Function
    Public Function myString2() As String 'ToStringのかわり、上下左右のピクセルのカウント数
        Return " TopX_Count=" & TopX.Count & " BottomX_Count=" & BottomX.Count & " LeftY_Count=" & LeftY.Count & " RightY_Count=" & RightY.Count
    End Function
    Public Function DrawWidth() As Integer '文字の幅
        Return RightX - LeftX + 1
    End Function
    Public Function DrawHeight() As Integer '文字の高さ
        Return BottomY - TopY + 1
    End Function
    Public Function DrawSize() As Size '文字の幅と高さ
        Return New Size(DrawWidth, DrawHeight)
    End Function
End Structure

 

 

 

DrawRange描画範囲

文字の幅とかをFunctionを使って返すように作ったけど

Propertyで持たせたほうがいいのかなあ、違いがわからん

 

Private Function DrawRange描画範囲情報(bmp) As DrawRange描画範囲
    Dim reInte As New DrawRange描画範囲
    reInte.TopX = New List(Of Integer) 'ここでNewしないとエラーになる、構造体の中ではNewできないので使うときにNewする
    reInte.BottomX = New List(Of Integer)
    reInte.LeftY = New List(Of Integer)
    reInte.RightY = New List(Of Integer)

    Dim w As Integer = bmp.Width
    Dim h As Integer = bmp.Height
    Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
    Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, bmp.PixelFormat)
    Dim ptr As IntPtr = bmpData.Scan0 'Bitmapデータが在るメモリのアドレス？
    Dim data As Integer = bmpData.Stride * h - 1 '入れ物の大きさ、Strideはbmp.width＊4になる？
    Dim pixels(data) As Byte '入れ物
    Runtime.InteropServices.Marshal.Copy(ptr, pixels, 0, pixels.Length) '入れ物にデータが入る、コピー
    Dim pos As Integer = 0 '入れ物のアドレス指定用
    Dim x, y As Integer
    Dim isFind As Boolean = False '上限、下限見つかったよフラグ

   '上の行から順番に色があるピクセルを探す
    For y = 0 To h - 1
        For x = 0 To w - 1
            pos = y * bmpData.Stride + x * 4
            If pixels(pos + 3) <> 0 Then 'アルファの値が0以上なら色があると判定、upperYに今の行位置を入れてループを抜ける
                If isFind = False Then
                    isFind = True
                   'reInte.TopY = y + 1 '+1しているのはBitmapのサイズは1からか始まるけどBitmapDataは0からで1ずれているからそれの修正、
                   '例えば2行目で色付きピクセルを見つけても1が記録されるので＋１している
                    reInte.TopY = y '後で使うときには0から数えたほうが良さそうなので+1しないように変更した
                End If

                reInte.TopX.Add(x) '上限での横位置、縦書で使う
               '配列というかリストになる、例えば「-」という文字なら横一直線なので左端から右端まですべてのピクセルの座標が入ることになる

            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
            pos = y * bmpData.Stride + x * 4
            If pixels(pos + 3) <> 0 Then
                If isFind = False Then
                    isFind = True
                    reInte.BottomY = y '+ 1 '下限

                End If
                reInte.BottomX.Add(x) '下限の横位置の配列

            End If
        Next
        If isFind Then Exit For
    Next
    isFind = False

   '左端
    For x = 0 To w - 1
        For y = 0 To h - 1
            pos = y * bmpData.Stride + x * 4
            If pixels(pos + 3) <> 0 Then
                If isFind = False Then
                    isFind = True
                    reInte.LeftX = x ' + 1
                End If
                reInte.LeftY.Add(y)
            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
            pos = y * bmpData.Stride + x * 4
            If pixels(pos + 3) <> 0 Then
                If isFind = False Then
                    isFind = True
                    reInte.RightX = x ' + 1
                End If
                reInte.RightY.Add(y)
            End If
        Next
        If isFind Then Exit For
    Next
    bmp.UnlockBits(bmpData)

    Return reInte
End Function

 

 

 

文字画像を受け取ってDrawRange描画範囲に入れて返す関数の

DrawRange描画範囲情報

並べてみると名前が紛らわしいなｗ

前回はGetPixelを使っていたけど

BitmapDataやLockBitを使うものに変更したので速くなった

 

Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
    Me.ListBox1.Items.Clear() 'リストボックスの初期化
    Me.ListBox1.Anchor = AnchorStyles.Top Or AnchorStyles.Left Or AnchorStyles.Right

    Me.PictureBox1.Width = 256
    Me.PictureBox1.Height = 178
   'Me.PictureBox1.Width = 100
    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 drawRange As New List(Of DrawRange描画範囲) 'コレクション

   '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)
        drawRange.Add(DrawRange描画範囲情報(bmp)) '描画した画像から色のついたPixelを探して上下左右の一番外側をコレクションに追加
        Me.ListBox1.Items.Add(str.Chars(i) & " = " & drawRange.Item(i).myString1()) 'リストボックスに表示

    Next

    For i = 0 To str.Length - 1
        Me.ListBox1.Items.Add(str.Chars(i) & " = " & drawRange.Item(i).myString2()) 'リストボックスに項目追加、
    Next

    bmp = New Bitmap(w, h)
    g = Graphics.FromImage(bmp)
   'g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
    Dim drawPoint As New PointF(0, 0)
    Dim margin As Integer = 0 '指定マージン
    Dim stringWidth As Integer = drawRange(0).RightX - drawRange(0).LeftX + 1 '文字列の幅

    drawPoint.X = -(drawRange(0).LeftX) + margin '最初の1文字目用
    g.DrawString(str.Chars(0), font, b, drawPoint, sf) '最初の1文字目の描画
    For i = 1 To str.Length - 1 '2文字目以降の描画
       '描画のx座標
       '描画座標 ＝ 前回の描画座標 ＋ 一個前の文字の幅 ＋ 一個前の文字の左空白 － 描画文字の左空白 ＋ 指定マージン
        drawPoint.X += drawRange(i - 1).DrawWidth + (drawRange(i - 1).LeftX) - (drawRange(i).LeftX) + margin
        g.DrawString(str.Chars(i), font, b, drawPoint, sf) '文字の描画

    Next
   '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) '赤枠描画

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

 

 

 

Button3のクリックイベント

strに入れた文字列が描画される

マージン指定はmarginのところ、ってこういうのは変数じゃなくて定数にした方がいいな

 

参照したところ

構造体と配列フィールド - Programming/.NET Framework/構造体 - 総武ソフトウェア推進所

http://smdn.jp/programming/netfx/struct/3_arrayfields/

 

 

 

 

バックアップファイル一式

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

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

VisualBasic2013 - OneDrive

ヤフーボックス

 

 

 

次回は2日後

gogowaten.hatenablog.com