午後わてんのブログ

ベランダ菜園とWindows用アプリ作成(WPFとC#)

Pixtack紫陽花2.7.68.153_グラデーションの角度指定変更、文字の描画のズレを力技で修正テスト

┠Pixtack紫陽花 #ソフトウェア
 
 
文字の描画でグラデーションの角度(向き)の指定方法を変更した
横、縦、左上、右上のラジオボタンを廃止して
0から360度の数値指定に変更、今の角度に+45と-45するボタンを付けた
 

f:id:gogowaten:20191017134114p:plain

左が前回、右が今回
グラデーションの角度を細かく指定できるようにした
ラジオボタンよりこっちのほうが管理がラク
アンチエイリアスのチェックボックスは表記をAAに省略して
マウスカーソルを乗せると説明が出るように変更した

f:id:gogowaten:20191017134133p:plain

文字の描画のところにタブが増えたけど背景書式以外はまだ動かない
 
 

文字の描画を全面的に書きなおしているので

前から気になっていたのをついでに直そうってのがあって
その一つが描画のズレ
 
イメージ 1
すべて描画起点はPoint(0,0)なのに
フォントによって描画される位置が違う
源ノ角ゴシック JP Regularはもっと下にしたいし
07ロゴたいぷゴシック7はもう少し上にしたい
どのフォントでも枠の中央に描画されるようにしたい
中央になるような描画起点の求め方は？
 
 
文字の描画について調べていて
フォントにはいろいろな設定値が在るみたい、アセント、ディセント、行間スペース
これでどうにかならないかなと例のごとくエクセルを使ってこねくり回した

f:id:gogowaten:20191017134206p:plain

けどわからない
 
なので一度実際に描画して一個づつピクセルを調べて色の付いている一番上と一番下のピクセルを探すという力技になったｗ
調べるにはGetpixelが使いやすいけど遅すぎるので
BitmapDataとかLockBitsを使うことになるけど、もう忘れたしよくわかっていないのでテストしたのが
これを使って
 

f:id:gogowaten:20191017134223p:plain

メモして
 
イメージ 4
フォントサイズが30のとき描画起点yのオフセット値が答えのところになる
全体の範囲-文字がある範囲(黒)が空白範囲(灰色)
空白範囲を上下半分にした範囲と今の上側の空白範囲を比べて
多ければその分引いいて、少なければ足す
その数値が答えのところ
答えの数値を使って描画位置を変更して描画したのが下の画像
 
イメージ 5
中央に描画されるようにできた！
イメージ 6
上限下限を探すのに使っているのがこの文字列
文字の中で一番上と下を使う物を選んだつもり
jyで一番下、klで一番上だと思ったけどフォントによっては日本語のほうが
上に来るものもあるみたいで07ロゴたいぷゴシック7ではklより
「文字」の上の部分のほうがより上になっている
文字の描画範囲を求める
Friend Function DrawSize文字の描画サイズ取得(str As String, myFont As Font, sFormat As StringFormat) As SizeF
    Dim canvas As New Bitmap(1, 1)
    Dim g As Graphics = Graphics.FromImage(canvas)
    Dim drawSizeF As SizeF
  
    drawSizeF = g.MeasureString(str, myFont, New PointF(0, 0), sFormat)
  
    Return drawSizeF

End Function
 
描画位置を求める
Private Function GetDrawPoint(myFont As Font, sFormat As StringFormat) As Point
   '実際に描画して計測
    Dim str As String = "jykl文字" '上限下限の判定に使う文字列
    Dim dSizeF As SizeF = DrawSize文字の描画サイズ取得(str, myFont, sFormat)
    Dim dSize As New Size(CInt(Math.Ceiling(dSizeF.Width)), CInt(Math.Ceiling(dSizeF.Height))) 'sizeFからSizeへの変換は切り上げ

    Dim w As Integer = dSize.Width
    Dim h As Integer = dSize.Height
    Dim canvas As New Bitmap(w, h)
    Dim g As Graphics = Graphics.FromImage(canvas)
    Dim rect As New Rectangle(New Point(0, 0), dSize)
    g.DrawString(str, myFont, Brushes.Red, rect, sFormat)

    Dim bd As BitmapData = canvas.LockBits(rect, ImageLockMode.ReadOnly, canvas.PixelFormat)
    Dim ptr As IntPtr = bd.Scan0 'Bitmapデータが在るメモリのアドレス？
    Dim data As Integer = bd.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 upperY, lowY, x, y As Integer '上限、下限
    Dim isFind As Boolean = False '上限、下限見つかったよフラグ


   '上の行から順番に色があるピクセルを探す
    For y = 0 To h - 1
        For x = 0 To w - 1
            pos = y * bd.Stride + x * 4
            If pixels(pos + 3) <> 0 Then 'アルファの値が0以上なら色があると判定、upperYに今の行位置を入れてループを抜ける
                upperY = y
                isFind = True
                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
            pos = y * bd.Stride + x * 4
            If pixels(pos + 3) <> 0 Then
                lowY = y
                isFind = True
                Exit For
            End If
        Next
        If isFind Then Exit For
    Next

    canvas.UnlockBits(bd) 'アンロック

    Dim moziH As Integer = lowY - upperY + 1 '文字だけの描画Height
    Dim spaceH As Integer = rect.Height - moziH '文字以外の空白Height
    Dim offY As Integer = CInt((spaceH / 2) - upperY) '空白を半分にして、それから上限を引く、これがオフセット値になる

    Dim wakuSize As New Size(rect.Width - 1, rect.Height - 1)
    Dim wakuRect As New Rectangle(New Point(0, 0), wakuSize)

    Dim dp As New Point(0, offY) '答え、オフセットポイント

    rect = New Rectangle(dp, dSize)
    canvas = New Bitmap(w, h)
    g = Graphics.FromImage(canvas)
    g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
    g.DrawRectangle(Pens.Red, wakuRect)
    g.DrawString(str, myFont, Brushes.Blue, rect, sFormat)

    Call Form1.PicBoxAdd("test", canvas)

    Return dp

End Function
 
かたちだけでもエレガントに行きたいのに、いつも力技になるｗ
でも、できたからいいや
といっても書き直しの途中なので、今の文字の描画では使えないデバッグ用
 
文字の描画の書き直しで設定ファイルの互換性がなくなったりすることが増えそう
 
ダウンロード
 
翌日