Creating Fonts

Perhaps the most confusing function in the GDI API is CreateFont. It has so many parameters the nice people at MS decided to make each parameter's name one or two characters in length. As you can imagine, this makes it impossible to use straight-off as can be done with the other GDI APIs. The following helper function makes creation of fonts very much simpler.

   Public Function DoCreateFont(Optional nSize As Single = 8.5, Optional FaceName As String = "Arial", Optional bUnderline As Boolean = False, Optional Weight As Long = FW_NORMAL) As Long
       'Create a specified font
       Dim hdc As Long
       hdc = GetDC(0)
       DoCreateFont = CreateFont( _
                       -MulDiv(nSize, GetDeviceCaps(hdc, LOGPIXELSY), 72), _
                       0, _
                       0, _
                       0, _
                       Weight, _
                       False, _
                       Abs(bUnderline), _
                       False, _
                       DEFAULT_CHARSET, _
                       OUT_DEFAULT_PRECIS, _
                       CLIP_DEFAULT_PRECIS, _
                       PROOF_QUALITY, _
                       DEFAULT_PITCH, _
                       FaceName)
       ReleaseDC 0, hdc
   End Function

This gives you most of what you need to do standard font creation. Other features could easily be added just by looking at the parameters of CreateFont in MSDN and translating them to understandable parameters in the helper function.

Creating a GDI font from an StdFont object

Another thing that is often necessary when working with fonts, especially in the context of ActiveX controls, is 'converting' an StdFont object to an hFont. Unfortunately this is not possible directly, so this function, provided by the wonderful people at vbAccelerator, shows how to do this:

   Public Function pOLEFontToHFont(fntThis As StdFont) As Long
       Dim sFont As String
       Dim iChar As Integer
       Dim b() As Byte
       Dim tLF As LOGFONT
       Dim hdc As Long
       
       hdc = GetDC(0)
       
       ' Convert an OLE StdFont to a LOGFONT structure:
       With tLF
           sFont = fntThis.Name
           b = StrConv(sFont, vbFromUnicode)
           For iChar = 1 To Len(sFont)
               .lfFaceName(iChar - 1) = b(iChar - 1)
           Next iChar
           ' Based on the Win32SDK documentation:
           .lfHeight = -MulDiv((fntThis.SIZE), (GetDeviceCaps(hdc, LOGPIXELSY)), 72)
           .lfItalic = fntThis.Italic
           If (fntThis.Bold) Then
               .lfWeight = FW_BOLD
           Else
               .lfWeight = FW_NORMAL
           End If
           .lfUnderline = fntThis.Underline
           .lfStrikeOut = fntThis.Strikethrough
           .lfCharSet = fntThis.Charset
       End With
       
       ReleaseDC 0, hdc
       
       pOLEFontToHFont = CreateFontIndirect(tLF)
   End Function