Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitleShow samples of the fonts available on the system
Keywordsfont, text
CategoriesGraphics
 
When this program starts, it loops through the Screen.Fonts collection displaying the font names and samples in a FlexGrid control.
 
Private Const SAMPLE_STRING = "VB Helper"

Private Sub Form_Load()
Dim i As Integer
Dim name_width As Single
Dim max_width As Single
Dim font_name As String

    flxFonts.Visible = False
    DoEvents

    lblSample.Caption = SAMPLE_STRING

    flxFonts.AllowUserResizing = flexResizeRows
    flxFonts.Rows = Screen.FontCount + 1
    flxFonts.TextMatrix(0, 0) = "Font Name"
    flxFonts.TextMatrix(0, 1) = "Sample"
    flxFonts.Row = 0
    flxFonts.Col = 0
    flxFonts.CellFontBold = True
    flxFonts.Col = 1
    flxFonts.CellFontBold = True

    For i = 0 To Screen.FontCount - 1
        font_name = Screen.Fonts(i)
        flxFonts.Row = i + 1
        flxFonts.Col = 0
        flxFonts.Text = font_name
        flxFonts.Col = 1
        flxFonts.Text = SAMPLE_STRING
        flxFonts.CellFontName = font_name

        name_width = TextWidth(font_name)
        If max_width < name_width Then max_width = _
            name_width
    Next i

    flxFonts.ColWidth(0) = max_width + 120
    flxFonts.ColWidth(1) = ScaleWidth - _
        flxFonts.ColWidth(0) - 360
    flxFonts.Visible = True
End Sub
 
When the user clicks on the FlexGrid, the program displays the selected font as large as possible while still fitting in the sample label.
 
Private Sub flxFonts_Click()
Dim font_size As Integer
Dim font_name As String

    ' Find the biggest font that will fit.
    font_name = flxFonts.TextMatrix(flxFonts.Row, 0)
    Font.Name = font_name
    font_size = 10
    Font.Size = font_size
    Do While TextHeight(SAMPLE_STRING) < lblSample.Height
        font_size = font_size + 1
        Font.Size = font_size
    Loop

    lblSample.Font.Name = font_name
    lblSample.Font.Size = font_size - 1
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated