CreateFontIndirectで正常にFontを取得できない？ (ID:146065)

名前

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

本文 いつもお世話になっております。 現在、CreateFontIndirect APIを使用して指定したフォントを 取得しようとしているのですが正常に取得できません。 （Defaultでセットされているフォントが選択されてしまう？） 以下のプログラムはForm上にボタン１個作成して、 そのボタンを押下するとフォーム上に"a"と表示されるようなものです。 本当はこれでフォントを変更して表示したりしたいのですが。。。 もし何か心当たりがある方がおられましたら、 大変申し訳ないのですが、教えていただけないでしょうか？ よろしくお願いいたします。 Imports Microsoft.DirectX.Direct3D Imports System.Runtime.InteropServices Public Class Form1 Public Enum _D3DTEXTUREOP ' Control D3DTOP_DISABLE = 1 ' disables stage D3DTOP_SELECTARG1 = 2 ' the default D3DTOP_SELECTARG2 = 3 ' Modulate D3DTOP_MODULATE = 4 ' multiply args together D3DTOP_MODULATE2X = 5 ' multiply and 1 bit D3DTOP_MODULATE4X = 6 ' multiply and 2 bits ' Add D3DTOP_ADD = 7 ' add arguments together D3DTOP_ADDSIGNED = 8 ' add with -0.5 bias D3DTOP_ADDSIGNED2X = 9 ' as above but left 1 bit D3DTOP_SUBTRACT = 10 ' Arg1 - Arg2, with no saturation D3DTOP_ADDSMOOTH = 11 ' add 2 args, subtract product ' Arg1 + Arg2 - Arg1*Arg2 ' = Arg1 + (1-Arg1)*Arg2 ' Linear alpha blend: Arg1*(Alpha) + Arg2*(1-Alpha) D3DTOP_BLENDDIFFUSEALPHA = 12 ' iterated alpha D3DTOP_BLENDTEXTUREALPHA = 13 ' texture alpha D3DTOP_BLENDFACTORALPHA = 14 ' alpha from D3DRS_TEXTUREFACTOR ' Linear alpha blend with pre-multiplied arg1 input: Arg1 + Arg2*(1-Alpha) D3DTOP_BLENDTEXTUREALPHAPM = 15 ' texture alpha D3DTOP_BLENDCURRENTALPHA = 16 ' by alpha of current color ' Specular mapping D3DTOP_PREMODULATE = 17 ' modulate with next texture before use D3DTOP_MODULATEALPHA_ADDCOLOR = 18 ' Arg1.RGB + Arg1.A*Arg2.RGB ' COLOROP only D3DTOP_MODULATECOLOR_ADDALPHA = 19 ' Arg1.RGB*Arg2.RGB + Arg1.A ' COLOROP only D3DTOP_MODULATEINVALPHA_ADDCOLOR = 20 ' (1-Arg1.A)*Arg2.RGB + Arg1.RGB ' COLOROP only D3DTOP_MODULATEINVCOLOR_ADDALPHA = 21 ' (1-Arg1.RGB)*Arg2.RGB + Arg1.A ' COLOROP only ' Bump mapping D3DTOP_BUMPENVMAP = 22 ' per pixel env map perturbation D3DTOP_BUMPENVMAPLUMINANCE = 23 ' with luminance channel ' This can do either diffuse or specular bump mapping with correct input. ' Performs the function (Arg1.R*Arg2.R + Arg1.G*Arg2.G + Arg1.B*Arg2.B) ' where each component has been scaled and offset to make it signed. ' The result is replicated into all four (including alpha) channels. ' This is a valid COLOROP only. D3DTOP_DOTPRODUCT3 = 24 ' Triadic ops D3DTOP_MULTIPLYADD = 25 ' Arg0 + Arg1*Arg2 D3DTOP_LERP = 26 ' (Arg0)*Arg1 + (1-Arg0)*Arg2 D3DTOP_FORCE_DWORD = &H7FFFFFFF End Enum Public Enum _D3DBLEND D3DBLEND_ZERO = 1 D3DBLEND_ONE = 2 D3DBLEND_SRCCOLOR = 3 D3DBLEND_INVSRCCOLOR = 4 D3DBLEND_SRCALPHA = 5 D3DBLEND_INVSRCALPHA = 6 D3DBLEND_DESTALPHA = 7 D3DBLEND_INVDESTALPHA = 8 D3DBLEND_DESTCOLOR = 9 D3DBLEND_INVDESTCOLOR = 10 D3DBLEND_SRCALPHASAT = 11 D3DBLEND_BOTHSRCALPHA = 12 D3DBLEND_BOTHINVSRCALPHA = 13 D3DBLEND_BLENDFACTOR = 14 'Only supported if D3DPBLENDCAPS_BLENDFACTOR is on */ D3DBLEND_INVBLENDFACTOR = 15 'Only supported if D3DPBLENDCAPS_BLENDFACTOR is on */ D3DBLEND_SRCCOLOR2 = 16 D3DBLEND_INVSRCCOLOR2 = 17 D3DBLEND_FORCE_DWORD = &H7FFFFFFF 'force 32-bit size enum */ End Enum Private Const LF_FACESIZE As Int32 = 32 Private FW_NORMAL As Int32 = 400 Private Const SHIFTJIS_CHARSET As Integer = 128 'シフトJIS文字セット Public Const OUT_DEFAULT_PRECIS As Integer = 0 'デフォルトの方法 Public Const CLIP_DEFAULT_PRECIS As Integer = 0 'デフォルトの方法 Public Const FIXED_PITCH As Integer = 1 '固定ピッチ Public Const FF_MODERN As Integer = 48 '固定幅ストローク、固定ピッチ、セリフあり・なし Public Const PROOF_QUALITY As Integer = 2 Public Const GDI_ERROR As Integer = &HFFFFFFFF Public Const GGO_GRAY4_BITMAP As Integer = 5 Public Const D3DTA_TEXTURE As Integer = &H2 ' select texture color (read only) Public Const D3DTA_DIFFUSE As Integer = &H0 ' select diffuse color (read only) <StructLayout(LayoutKind.Sequential, pack:=4)> _ Public Structure LOGFONT Public lfHeight As Integer Public lfWidth As Integer Public lfEscapement As Integer Public lfOrientation As Integer Public lfWeight As Integer Public lfItalic As Byte Public lfUnderline As Byte Public lfStrikeOut As Byte Public lfCharSet As Byte Public lfOutPrecision As Byte Public lfClipPrecision As Byte Public lfQuality As Byte Public lfPitchAndFamily As Byte <VBFixedString(LF_FACESIZE)> Public lfFaceName As String End Structure <StructLayout(LayoutKind.Sequential, Pack:=4)> _ Public Structure GLYPHMETRICS Public gmBlackBoxX As UInteger Public gmBlackBoxY As UInteger Public gmptGlyphOrigin As POINTAPI Public gmCellIncX As Short Public gmCellIncY As Short End Structure <StructLayout(LayoutKind.Sequential, Pack:=4)> _ Public Structure POINTAPI Public x As Integer Public y As Integer End Structure <StructLayout(LayoutKind.Sequential, Pack:=4)> _ Public 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)> _ Public Structure FIXED Public fract As Short Public value As Short End Structure <StructLayout(LayoutKind.Sequential, pack:=4)> _ Public Structure TEXTMETRIC Public tmHeight As Integer Public tmAscent As Integer Public tmDescent As Integer Public tmInternalLeading As Integer Public tmExternalLeading As Integer Public tmAveCharWidth As Integer Public tmMaxCharWidth As Integer Public tmWeight As Integer Public tmOverhang As Integer Public tmDigitizedAspectX As Integer Public tmDigitizedAspectY As Integer Public tmFirstChar As Byte Public tmLastChar As Byte Public tmDefaultChar As Byte Public tmBreakChar As Byte Public tmItalic As Byte Public tmUnderlined As Byte Public tmStruckOut As Byte Public tmPitchAndFamily As Byte Public tmCharSet As Byte End Structure Public Declare Function SelectObject Lib "gdi32" _ (ByVal hdc As IntPtr, _ ByVal hgdiobj As IntPtr) As IntPtr Public Declare Function DeleteObject Lib "gdi32" _ (ByVal hObject As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean Public 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 Public 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 Public Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (ByRef lpLogFont As LOGFONT) As IntPtr Public Declare Function GetDC Lib "user32.dll" (ByVal hwnd As IntPtr) As IntPtr Public Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As IntPtr, ByVal hdc As IntPtr) As IntPtr Public Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hdc As IntPtr, ByRef lpMetrics As TEXTMETRIC) As Integer Public Declare Function GetLastError Lib "kernel32" () As Integer Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim param As New PresentParameters() param.Windowed() = True param.SwapEffect = SwapEffect.Discard param.PresentationInterval = PresentInterval.Immediate Using _Device As New Device(0, DeviceType.Hardware, Me, CreateFlags.SoftwareVertexProcessing, param) 'フォント作成 Dim fontSize As Integer = 256 Dim lf As LOGFONT lf.lfHeight = fontSize lf.lfWeight = FW_NORMAL lf.lfCharSet = SHIFTJIS_CHARSET lf.lfOutPrecision = OUT_DEFAULT_PRECIS lf.lfClipPrecision = CLIP_DEFAULT_PRECIS lf.lfQuality = PROOF_QUALITY lf.lfPitchAndFamily = FIXED_PITCH Or FF_MODERN lf.lfFaceName = "ＭＳ Ｐゴシック" Dim hFont As IntPtr = CreateFontIndirect(lf) 'デバイスコンテキスト取得 Dim hDC As IntPtr = GetDC(IntPtr.Zero) 'プライマリモニタのDC取得 Dim oldFont As IntPtr = SelectObject(hDC, hFont) Using f As System.Drawing.Font = Font.FromHfont(hFont) Debug.Print(f.ToString) End Using '文字コード取得 Dim c As String = "a" Dim code As Integer = AscW(c) 'フォントビットマップ取得 Dim TM As New TEXTMETRIC GetTextMetrics(hDC, TM) Dim GM As GLYPHMETRICS Dim Mat As MAT2 Mat.eM11.value = 1 Mat.eM12.value = 0 Mat.eM21.value = 0 Mat.eM22.value = 1 Dim size As Integer = GetGlyphOutline(hDC, code, GGO_GRAY4_BITMAP, GM, 0, IntPtr.Zero, Mat) Dim ptr(0) As Byte If size = GDI_ERROR Then MsgBox("エラー:" + GetLastError().ToString, MsgBoxStyle.Exclamation) Else ReDim ptr(size) GetGlyphOutline(hDC, code, GGO_GRAY4_BITMAP, GM, size, ptr(0), Mat) End If 'デバイスコンテキストとフォアハンドルの解放 SelectObject(hDC, oldFont) DeleteObject(hFont) ReleaseDC(IntPtr.Zero, hDC) '頂点情報 Dim a As Single = 1.0 'テクスチャの縮尺 Dim fTexW As Single = GM.gmCellIncX * a 'テクスチャの横幅 Dim fTexH As Single = TM.tmHeight * a 'テクスチャの高さ Dim FontColor As Integer = &H88FFFFFF 'テクスチャカラー(透明度50%) '頂点バッファ作成 Using pVertex As New VertexBuffer(GetType(CustomVertex.TransformedColoredTextured), 4, _Device, Usage.None _ , CustomVertex.TransformedColoredTextured.Format, Pool.Managed) '頂点情報の書込み Dim v() As CustomVertex.TransformedColoredTextured = DirectCast(pVertex.Lock(0, 0), CustomVertex.TransformedColoredTextured()) v(0) = New CustomVertex.TransformedColoredTextured(fTexW, 0.0, 0.0, 1.0, FontColor, 1.0, 0.0) v(1) = New CustomVertex.TransformedColoredTextured(fTexW, fTexH, 0.0, 1.0, FontColor, 1.0, 1.0) v(2) = New CustomVertex.TransformedColoredTextured(0.0, 0.0, 0.0, 1.0, FontColor, 0.0, 0.0) v(3) = New CustomVertex.TransformedColoredTextured(0.0, fTexH, 0.0, 1.0, FontColor, 0.0, 1.0) pVertex.Unlock() 'テクスチャ作成 Dim pTex As Texture Try pTex = New Texture(_Device, GM.gmCellIncX, TM.tmHeight, 1, Usage.Dynamic, Format.A8R8G8B8, Pool.Default) Catch ex1 As Exception Try pTex = New Texture(_Device, GM.gmCellIncX, TM.tmHeight, 1, Usage.None, Format.A8R8G8B8, Pool.Managed) Catch ex As Exception MsgBox("エラー") Return End Try End Try 'テクスチャにフォントビットマップ書込み Dim desc As SurfaceDescription = pTex.GetLevelDescription(0) Dim ipa(1) As Integer ipa(0) = desc.Height ipa(1) = desc.Width Dim buf(,) As UInt32 = DirectCast(pTex.LockRectangle(GetType(UInt32), 0, LockFlags.None, ipa), UInt32(,)) Array.Clear(buf, 0, buf.Length) Dim iOfs_x As Integer = GM.gmptGlyphOrigin.x Dim iOfs_y As Integer = TM.tmAscent - GM.gmptGlyphOrigin.y Dim iBmp_w As Integer = CType(GM.gmBlackBoxX, Integer) + (4 - (CType(GM.gmBlackBoxX, Integer) Mod 4)) Mod 4 Dim iBmp_h As Integer = CType(GM.gmBlackBoxY, Integer) Dim Level As Integer = 17 Dim x As Integer, y As Integer Dim Alpha As Long, Color As Long For y = iOfs_y To (iOfs_y + iBmp_h) - 1 For x = iOfs_x To (iOfs_x + iBmp_w) - 1 Alpha = CType((255 * ptr(x - iOfs_x + iBmp_w * (y - iOfs_y))) / (Level - 1), Long) Color = &HFFFFFF Or (Alpha << 24) If y > buf.GetUpperBound(0) OrElse x > buf.GetUpperBound(1) Then Else buf(y, x) = CType(Color, UInteger) End If Next Next pTex.UnlockRectangle(0) ptr = Nothing 'テクスチャセット _Device.SetTexture(0, pTex) _Device.SetTextureStageState(0, TextureStageStates.ColorArgument1, D3DTA_TEXTURE) _Device.SetTextureStageState(0, TextureStageStates.ColorOperation, _D3DTEXTUREOP.D3DTOP_MODULATE) _Device.SetTextureStageState(0, TextureStageStates.ColorArgument2, D3DTA_DIFFUSE) _Device.SetTextureStageState(0, TextureStageStates.AlphaArgument1, D3DTA_TEXTURE) _Device.SetTextureStageState(0, TextureStageStates.AlphaOperation, _D3DTEXTUREOP.D3DTOP_MODULATE) _Device.SetTextureStageState(0, TextureStageStates.AlphaArgument2, D3DTA_DIFFUSE) '板ポリのα値を利用 'レンダリングステート _Device.SetRenderState(RenderStates.AlphaBlendEnable, True) _Device.SetRenderState(RenderStates.SourceBlend, _D3DBLEND.D3DBLEND_SRCALPHA) _Device.SetRenderState(RenderStates.DestinationBlend, _D3DBLEND.D3DBLEND_INVSRCALPHA) 'メッセージループ Do While Me.Created System.Threading.Thread.Sleep(1) System.Windows.Forms.Application.DoEvents() If Me.Created Then _Device.Clear(ClearFlags.Target, Drawing.Color.Blue, 1.0, 0) _Device.BeginScene() _Device.SetStreamSource(0, pVertex, 0) _Device.VertexFormat = CustomVertex.TransformedColoredTextured.Format _Device.DrawPrimitives(PrimitiveType.TriangleStrip, 0, 2) _Device.EndScene() _Device.Present() End If Loop pTex.Dispose() End Using End Using End Sub End Class