CreateFontA

VB.Net

---

Imports System.Runtime.InteropServices

Module CreateFont
    Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Int32, ByVal nWidth As Int32,
    ByVal nEscapement As Int32, ByVal nOrientation As Int32,
    ByVal fnWeight As Int32, ByVal fdwItalic As UInt32,
    ByVal fdwUnderline As UInt32, ByVal fdwStrikeOut As UInt32,
    ByVal fdwCharSet As Int32, ByVal fdwOutputPrecision As UInt32,
    ByVal fdwClipPrecision As UInt32, ByVal fdwQuality As UInt32,
    ByVal fdwPitchAndFamily As UInt32, ByVal lpszFace As String
    ) As IntPtr

    <DllImport("GDI32.dll")>
    Public Function SelectObject(ByVal hdc As IntPtr,
                                        ByVal hObject As IntPtr) As IntPtr
    End Function

    <DllImport("GDI32.dll")>
    Public Function DeleteObject(ByVal obj As IntPtr) As Boolean
    End Function

    Private Declare Function SendMessage _
      Lib "user32.dll" Alias "SendMessageA" _
      (ByVal hwnd As Integer,
      ByVal wMsg As Integer,
      ByVal wParam As Integer,
      ByRef lParam As Integer) _
      As Integer

    Private Const WM_SETFONT As Integer = &H30

    Sub CreateFont_Main()
        ' Create a new font face name
        Dim fontFaceName As String = "Arial"

        ' Create a new font with the specified metrics and style
        ''Dim hFont As IntPtr = CreateFont(12, 0, 0, 0, 0, fontFaceName, FontStyle.Regular Or FontStyle.Italic)
        Dim f As IntPtr = CreateFont(30, 20, 0, 0, 400, False, False, False, 1, 0, 0, 4, 0, fontFaceName)

        ' Check for success or error codes
        If f <> 0 Then
            Console.WriteLine("Font created successfully: {0}", fontFaceName)
            Dim hwindow As IntPtr = Form1.TextBox1.Handle
            SendMessage(hwindow, WM_SETFONT, f, 0)
            Form1.TextBox1.Text = "1234567890"
            Form1.ActiveControl = Form1.Label1
        Else
            Console.WriteLine("Error creating font: {0}", Marshal.GetLastWin32Error())
        End If
        DeleteObject(f)

    End Sub
End Module