VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6390
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   6390
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdApply 
      Caption         =   "Apply"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4800
      TabIndex        =   5
      Top             =   2160
      Width           =   1215
   End
   Begin VB.ComboBox cboFontSize 
      Height          =   315
      Left            =   2640
      TabIndex        =   4
      Text            =   "Combo2"
      Top             =   1680
      Width           =   3375
   End
   Begin VB.ComboBox cboFonts 
      Height          =   315
      Left            =   2640
      Sorted          =   -1  'True
      TabIndex        =   3
      Text            =   "Combo1"
      Top             =   1200
      Width           =   3375
   End
   Begin VB.ListBox List1 
      Height          =   1815
      Left            =   240
      TabIndex        =   2
      Top             =   1080
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   2520
      TabIndex        =   1
      Top             =   360
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   480
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cboFonts_Click()
LoadFontSizes
End Sub

Private Sub LoadFontSizes()
Dim SaveName As String
Dim SaveSize As Single
Dim Sizes As Variant
Dim i As Long
'place holders for font name and font size
SaveName = cboFontSize.Font.Name
SaveSize = cboFontSize.Font.Size

Sizes = Array(6, 7, 8, 9, 10, 11, 12, 14, 16, 18, 20, 22, 24, 26, 28, 36, 48, 72)
cboFontSize.Clear
'this is the font the user has selected
cboFontSize.FontName = cboFonts.Text
    'whip through the array checking all possible font sizes
    For i = LBound(Sizes) To UBound(Sizes)
        cboFontSize.FontSize = CLng(Sizes(i))
        'font supports this size, add to combo
           If cboFontSize.FontSize = CLng(Sizes(i)) Then
              cboFontSize.AddItem Sizes(i)
           End If
    Next
 cboFontSize.FontName = SaveName
 cboFontSize.FontSize = SaveSize
End Sub

Private Sub cboFontSize_Click()
cmdApply.Enabled = True
End Sub


Private Sub cmdApply_Click()
Dim ctrl As Control
For Each ctrl In Me.Controls
   ctrl.Font.Name = cboFonts.Text
   ctrl.Font.Size = cboFontSize.Text
Next
End Sub


Private Sub Form_Load()
   Dim i As Long
    For i = 0 To Screen.FontCount - 1
        cboFonts.AddItem Screen.Fonts(i)
    Next
    cboFonts.ListIndex = 0
'same list stuff
With List1
.AddItem "Apples"
.AddItem "Grapes"
.AddItem "Pears"
End With
End Sub