|
|
|
| Title | Show samples of the fonts available on the system |
|---|
| Keywords | font, text |
|---|
| Categories | Graphics |
|---|
|
|
|
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
|
| |
|
| |
|
|
