That didn't help me much...
When I try to open the form, I get the message:
"There are no fonts installed.
Open the Fonts folder from the Control Panel to install fonts."
I do have fonts installed... This is the code I have:
Code:
Private Sub Command3_Click()
Dim cf As CHOOSEFONT_TYPE
Dim lfont As LOGFONT
Dim hMem As Long, pMem As Long
Dim fontname As String
Dim retval As Long
lfont.lfHeight = 0
lfont.lfWidth = 0
lfont.lfEscapement = 0
lfont.lfOrientation = 0
lfont.lfWeight = FW_NORMAL
lfont.lfItalic = 0
lfont.lfUnderline = 0
lfont.lfStrikeOut = 0
lfont.lfCharSet = DEFAULT_CHARSET
lfont.lfOutPrecision = OUT_DEFAULT_PRECIS
lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS
lfont.lfQuality = DEFAULT_QUALITY
lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN
lfont.lfFaceName = "Times New Roman" & vbNullChar
' Create the memory block which will act as the LOGFONT structure buffer.
hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
pMem = GlobalLock(hMem)
CopyMemory ByVal pMem, lfont, Len(lfont)
' Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
cf.lStructSize = Len(cf)
cf.hwndOwner = Form1.hWnd
cf.hDC = Printer.hDC
cf.lpLogFont = pMem
cf.iPointSize = 120
cf.Flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
cf.rgbColors = RGB(0, 0, 0)
cf.lCustData = 0
cf.lpfnHook = 0
cf.lpTemplateName = ""
cf.hInstance = 0
cf.lpszStyle = ""
cf.nFontType = REGULAR_FONTTYPE
cf.nSizeMin = 10
cf.nSizeMax = 72
retval = ChooseFont(cf)
If retval <> 0 Then
CopyMemory lfont, ByVal pMem, Len(lfont)
fontname = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
Debug.Print "FONT NAME: "; fontname
Debug.Print "FONT SIZE (points):"; cf.iPointSize / 10
Debug.Print "FONT STYLE(S): ";
If lfont.lfWeight >= FW_BOLD Then Debug.Print "Bold ";
If lfont.lfItalic <> 0 Then Debug.Print "Italic ";
If lfont.lfUnderline <> 0 Then Debug.Print "Underline ";
If lfont.lfStrikeOut <> 0 Then Debug.Print "Strikeout";
Debug.Print
End If
retval = GlobalUnlock(hMem)
retval = GlobalFree(hMem)
End Sub