Font listing

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

Hows this ?

Code:

---

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

You can enumerate a list using font object

Code:

---

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:

Code:

---

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

---