DOBON.NET DOBON.NETプログラミング掲示板過去ログ

テキストボックスのフォント指定方法

  • 題名: テキストボックスのフォント指定方法
  • 著者: taktak
  • 日時: 2007/10/23 0:28:23
  • ID: 20793
  • この記事の返信元:
    • (なし)
  • この記事への返信:
    • (なし)
  • ツリーを表示
環境/言語:[環境はOS:XPSP2-VS2005-VB.NET-NET Framework2.0です。]
分類:[.NET]

フォームのテキストボックス(TextBox1)の文字を指定したフォントで表示させたいと思っています。指定するフォントはデザイン画面のFONTプロパティのフォント名リストにないフォントです。(文字ベンダー作の外字を含む特殊フォント)
SendMessageであればどんなフォントでも表示可能と聞いたもんで…。以下のコードではうまくいきません。追加する部分があるのでしょうか?


Public Class useFixedSys

Public Const LF_FACESIZE As Int32 = 32
Public Const DEFAULT_CHARSET As Byte = 1
Public Const FW_NORMAL As Int32 = 400
Public Const FIXED_PITCH As Byte = 1
Public Const OUT_RASTER_PRECIS As Byte = 6
Public Const WM_SETFONT As Int32 = &H30


<StructLayout(LayoutKind.Sequential)> _
Public Structure LOGFONT
Public lfHeight As Int32
Public lfWidth As Int32
Public lfEscapement As Int32
Public lfOrientation As Int32
Public lfWeight As Int32
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
Public Sub New(ByVal fontName As String)
lfWeight = FW_NORMAL
lfCharSet = DEFAULT_CHARSET
lfPitchAndFamily = FIXED_PITCH
lfOutPrecision = OUT_RASTER_PRECIS
lfFaceName = fontName
lfHeight = 32
End Sub
End Structure

Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (ByRef lpLogFont As LOGFONT) As Int32
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Integer


'Private Shared mLF As New LOGFONT("FixedSys")
Private Shared mLF As New LOGFONT("Impact")

Private Shared hFixedSys As Int32

Public Shared Sub SetFont(ByVal hWnd As IntPtr)
hFixedSys = CreateFontIndirect(mLF)
SendMessage(hWnd, WM_SETFONT, hFixedSys, 1)
End Sub
Protected Overrides Sub Finalize()
MyBase.Finalize()
If hFixedSys <> 0 Then
DeleteObject(hFixedSys)
End If
End Sub
End Class


'フォームロード時にテキストボックスのフォントを指定フォントにする
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

useFixedSys.SetFont(TextBox1.Handle)
TextBox1.AppendText("ABCDEFGH")

end Sub

DOBON.NET | プログラミング道 | プログラミング掲示板