VB.NETでGetGlyphOutlineを使用するには

解決

---

[ 環境：VB.NET 2005 ]
GetGlyphOutline APIを使用して文字のアウトラインを
取得しようとしているのですが、APIの宣言が悪いのか、
何が悪いのか文字サイズが正しく返ってきません。
使用方法や宣言で間違っているところがありましたら、
ご指摘いただけないでしょうか？
よろしくお願いいたします。

[ 宣言 ]
Public Declare Function GetDC Lib "user32.dll" (ByVal hwnd As IntPtr) As IntPtr
Public Declare Function GetGlyphOutline Lib "gdi32"                 Alias "GetGlyphOutlineA" (ByVal hdc As IntPtr, ByVal uChar As Long, ByVal fuFormat As Long, ByRef lpgm As GLYPHMETRICS, ByVal cbBuffer As Long, ByVal lpBuffer As Long, ByRef lpmat2 As MAT2) As Long

Public Structure POINTAPI
  Public x As Long
  Public y As Long
End Structure

Public Structure GLYPHMETRICS
  Public gmBlackBoxX As Long
  Public gmBlackBoxY As Long
  Public gmptGlyphOrigin As POINTAPI
  Public gmCellIncX As Integer
  Public gmCellIncY As Integer
End Structure

Public Structure FIXED
  Public fract As Integer
  Public value As Integer
End Structure

Public Structure MAT2
  Public eM11 As FIXED
  Public eM12 As FIXED
  Public eM21 As FIXED
  Public eM22 As FIXED
End Structure

[ 使用箇所 ]
Dim mat As MAT2
Dim uicharacter As Long
Dim dsize As Long
Dim pBMP() As Byte
Dim gm As GLYPHMETRICS
Dim hdc As IntPtr = GetDC(IntPtr.Zero)

With mat
  .eM11.value = 1     
  .eM12.value = 0
  .eM21.value = 0
  .eM22.value = 1     
End With

uicharacter = Asc("a")

'サイズを取得
dsize = GetGlyphOutline(hdc, uicharacter, GGO_GRAY4_BITMAP _
                      , gm, 0, Nothing, mat)

'このdsizeに巨大な値(283695307298963455)が戻されて
'以下のメモリを確保するところでOverflowExceptionが発生します。

'必要なサイズのメモリを確保
ReDim pBMP(Integer.Parse(dsize.ToString))

'アウトラインを取得
GetGlyphOutline(hdc, uicharacter, GGO_GRAY4_BITMAP, gm _
              , dsize, pBMP(0), mat)

編集 削除

---

以下の宣言でどうでしょう？

Imports System.Runtime.InteropServices

    Public Declare Function GetGlyphOutline Lib "gdi32" Alias "GetGlyphOutlineA" _
        (ByVal hdc As Integer, ByVal uChar As Integer, ByVal fuFormat As Integer, _
        <MarshalAs(UnmanagedType.Struct)> ByRef lpgm As GLYPHMETRICS, _
        ByVal cbBuffer As Integer, ByVal lpBuffer As IntPtr, _
        <MarshalAs(UnmanagedType.Struct)> ByRef lpmat2 As MAT2) As Integer

    <StructLayout(LayoutKind.Sequential)> Public Structure GLYPHMETRICS
        Public gmBlackBoxX As Integer
        Public gmBlackBoxY As Integer
        Public gmptGlyphOrigin As POINTAPI
        Public gmCellIncX As Integer
        Public gmCellIncY As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential)> Public Structure POINTAPI
        Public x As Integer
        Public y As Integer
    End Structure

    <StructLayout(LayoutKind.Sequential)> Public Structure MAT2
        Public eM11 As FIXED
        Public eM12 As FIXED
        Public eM21 As FIXED
        Public eM22 As FIXED
    End Structure

    <StructLayout(LayoutKind.Sequential)> Public Structure FIXED
        Public fract As Integer
        Public Value As Integer
    End Structure

編集 削除

---

AE85さんアドバイスありがとうございます。
で、宣言を書換えて試してみました。

GetGlyphOutlineの戻り値が-1(エラー)となりましたので、
GetLastErrorでエラー内容を調べてみたところ、
『1003：この関数を完了できません』
というものが返ってきました。

そこで、もう少し調べると、
http://www.codeguru.com/forum/archive/index.php/t-297308.html
で、この関数を呼ぶ前にTrueTypeFontをセットしなければならない
というのを見つけましたので、ちょっとやってみて結果をまた書込みます。

他に何かアイディアがありましたら
よろしくお願いいたします。

編集 削除

---

TrueTypeFontをセットしてやってみたのですが、
結果は変わらず、GetGlyphOutlineの戻り値は-1、
GetLastErrorの戻り値は1003でした。

以下、コードです。

Dim gm As GLYPHMETRICS

'フォント作成
Dim fontSize As Integer = 12
Dim lf As [Static].LOGFONT
lf.lfHeight = fontSize
lf.lfWeight = FW_NORMAL
lf.lfCharSet = ANSI_CHARSET
lf.lfOutPrecision = OUT_DEFAULT_PRECIS
lf.lfClipPrecision = CLIP_DEFAULT_PRECIS
lf.lfQuality = DEFAULT_QUALITY
lf.lfPitchAndFamily = FF_SWISS + DEFAULT_PITCH
lf.lfFaceName = "Arial"

Dim hFont As Integer = CreateFontIndirect(lf)

'DC取得
Dim hDC As Integer = GetDC(Nothing)  'プライマリモニタのDC取得
Dim oldFont As Integer = SelectObject(hDC, hFont)

Dim mat As MAT2
With mat

    .eM11.Value = 1     '-1にすると左右反転
    .eM12.Value = 0
    .eM21.Value = 0
    .eM22.Value = 1     '-1にすると上下反転

End With

'コード取得
Dim uicharacter As Integer = Asc("a")

'データ格納に必要なサイズを計算
dim dsize as Integer = GetGlyphOutline(hDC, uicharacter _
, GGO_GRAY4_BITMAP, gm, 0, Nothing, mat)
If dsize = -1 Then
    Debug.Print("Error=" + GetLastError().ToString)
    SelectObject(hDC, oldFont)
    DeleteObject(hFont)
    ReleaseDC(Nothing, hDC)
    DeleteObject(hDC)
    hdc = Nothing
    Return
End If

編集 削除

---

> [ 環境：VB.NET 2005 ]
VB2005 だと API 版を使うことになりますね。
System.Windows.Media.GlyphTypeface.GetGlyphOutline メソッドは
.NET 3.0 からの実装なので…。


> 使用方法や宣言で間違っているところがありましたら、
ざっと見たところ、宣言部分において
  Int16(UInt16) / Int32(UInt32) / Int64(UInt64)
の使い分けが間違っている気がします。

こんな感じでどうでしょうか。

'-----
Imports System.Runtime.InteropServices
Imports System.IO

Partial Public Class Form1
    Private Declare Function SelectObject Lib "gdi32" _
       (ByVal hdc As IntPtr, _
        ByVal hgdiobj As IntPtr) As IntPtr

    Private Declare Function DeleteObject Lib "gdi32" _
        (ByVal hobj As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean

    Private Declare Unicode Function GetGlyphOutline Lib "gdi32" _
       (ByVal hdc As IntPtr, _
        ByVal uChar As Integer, _
        ByVal fuFormat As Integer, _
        ByRef lpgm As GLYPHMETRICS, _
        ByVal cbBuffer As Integer, _
        ByVal lpBuffer As IntPtr, _
        ByRef lpmat2 As MAT2) As Integer

    Private Declare Unicode Function GetGlyphOutline Lib "gdi32" _
       (ByVal hdc As IntPtr, _
        ByVal uChar As Integer, _
        ByVal fuFormat As Integer, _
        ByRef lpgm As GLYPHMETRICS, _
        ByVal cbBuffer As Integer, _
        ByRef lpBuffer As Byte, _
        ByRef lpmat2 As MAT2) As Integer

    <StructLayout(LayoutKind.Sequential, Pack:=4)> _
    Private Structure GLYPHMETRICS
        Public gmBlackBoxX As UInteger      'UINT
        Public gmBlackBoxY As UInteger      'UINT
        Public gmptGlyphOrigin As POINTAPI  'POINT
        Public gmCellIncX As Short          'short
        Public gmCellIncY As Short          'short
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=4)> _
    Private Structure POINTAPI
        Public x As Integer     'LONG
        Public y As Integer     'LONG
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=4)> _
    Private Structure MAT2
        Public eM11 As FIXED
        Public eM12 As FIXED
        Public eM21 As FIXED
        Public eM22 As FIXED
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=4)> _
    Private Structure FIXED
        Public fract As Short   'WORD
        Public value As Short   'short
    End Structure

    Private Const GGO_GRAY2_BITMAP As Integer = 4
    Private Const GGO_GRAY4_BITMAP As Integer = 5
    Private Const GGO_GRAY8_BITMAP As Integer = 6
    Private Const GGO_GLYPH_INDEX As Integer = &H80

    Private Const GDI_ERROR As Integer = &HFFFFFFFF

    Private bmp As Bitmap
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Using bmpDummy As New Bitmap(100, 100), _
              g As Graphics = Graphics.FromImage(bmpDummy), _
              f As New Font("Arial", 12)

            Dim hdc As IntPtr = g.GetHdc()
            Dim hFont As IntPtr = f.ToHfont()
            Dim oldFont As IntPtr = SelectObject(hdc, hFont)

            Dim mat As MAT2
            With mat
                .eM11.value = 1
                .eM12.value = 0
                .eM21.value = 0
                .eM22.value = 1
            End With

            Dim uicharacter As Integer = AscW("a")
            Dim gm As GLYPHMETRICS, dsize As Integer
            dsize = GetGlyphOutline(hdc, uicharacter, GGO_GRAY4_BITMAP, gm, 0, IntPtr.Zero, mat)
            If dsize = GDI_ERROR Then
                MsgBox("エラー:" & CStr(Err.LastDllError))
            Else
                Dim pBMP(dsize - 1) As Byte
                dsize = GetGlyphOutline(hdc, uicharacter, GGO_GRAY4_BITMAP, gm, pBMP.Length, pBMP(0), mat)
                File.WriteAllBytes("C:\RESULT.BIN", pBMP)
            End If

            SelectObject(hdc, oldFont)
            DeleteObject(hFont)
            g.ReleaseHdc(hdc)
        End Using
    End Sub
End Class

編集 削除

---

魔界の仮面弁士さんありがとうございます。
提示いただいたコードで問題なく動きました＾＾

内容を理解して使用したいと思います。
ありがとうございました。

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。

返信する