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