Font listing

[ez]

Is there any easy way to bring up a window with all the fonts avilable on a computer?

[PRIVATE1]

Hows this ?

Private Sub Form_Load()
 
 Dim intBuffer As Integer, strFont As String
 
   'load printer fonts to combobox
   If Dir$(App.Path & "\fonts.dat") = "" Then
        'font file doesnt exist. Create it.
        Open App.Path & "\fonts.dat" For Output As #1
             For intBuffer% = 0 To Printer.FontCount - 1
                Call cmbFonts.AddItem(Printer.Fonts(intBuffer%))
                Print #1, Printer.Fonts(intBuffer%)
             Next intBuffer%
        Close #1
   Else
        'load fonts from file
        Open App.Path & "\fonts.dat" For Input As #1
             While Not EOF(1)
                Input #1, strFont$
                Call cmbFonts.AddItem(strFont$)
             Wend
        Close #1
   End If
   
 cmbFonts.ListIndex = 0
 ''cmbFonts.Sorted = True 'Alphabetize list


  'set combobox to "Arial"
  For intBuffer% = 0 To cmbFonts.ListCount - 1
    If cmbFonts.List(intBuffer%) = "Arial" Then cmbFonts.ListIndex = intBuffer%: Exit For
  Next intBuffer%

You need a list box

[kedaman]

You can enumerate a list using font object

For n = 0 To Screen.FontCount - 1
List1.AddItem Screen.Fonts(n)
Next n

Same goes for the Printer. Simply use kedaman's code and replace Screen with Printer.

If you want to use CommonDialog to do it:

Private Sub Command1_Click()
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth
CommonDialog1.ShowFont
Text1.Font.Name = CommonDialog1.FontName
Text1.Font.Size = CommonDialog1.FontSize
Text1.Font.Bold = CommonDialog1.FontBold
Text1.Font.Italic = CommonDialog1.FontItalic
Text1.Font.Underline = CommonDialog1.FontUnderline
Text1.FontStrikethru = CommonDialog1.FontStrikethru
Text1.ForeColor = CommonDialog1.Color
Exit Sub
ErrHandler:
Exit Sub
End Sub