VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form frmFontInfo 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "FontInfo"
   ClientHeight    =   5490
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7620
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5490
   ScaleWidth      =   7620
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdView 
      Caption         =   "View..."
      Height          =   375
      Left            =   6240
      TabIndex        =   11
      Top             =   720
      Width           =   1215
   End
   Begin VB.CommandButton cmdUninstall 
      Caption         =   "Uninstall"
      Height          =   375
      Left            =   6240
      TabIndex        =   10
      Top             =   1920
      Width           =   1215
   End
   Begin VB.CommandButton cmdInstall 
      Caption         =   "Install"
      Height          =   375
      Left            =   6240
      TabIndex        =   9
      Top             =   1320
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog cdlFont 
      Left            =   6960
      Top             =   2520
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
      CancelError     =   -1  'True
      DefaultExt      =   "*.ttf"
      DialogTitle     =   "Choose A Font"
      Filter          =   "TrueType Fonts (*.ttf) | *.ttf"
      InitDir         =   "C:\"
   End
   Begin VB.CommandButton cmdSelect 
      Caption         =   "Select..."
      Height          =   375
      Left            =   6240
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      Caption         =   "Copyright:"
      Height          =   195
      Left            =   240
      TabIndex        =   19
      Top             =   4440
      Width           =   705
   End
   Begin VB.Label Label7 
      AutoSize        =   -1  'True
      Caption         =   "Version:"
      Height          =   195
      Left            =   240
      TabIndex        =   18
      Top             =   600
      Width           =   570
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "Trademark:"
      Height          =   195
      Left            =   240
      TabIndex        =   17
      Top             =   3600
      Width           =   810
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "Postscript Name:"
      Height          =   195
      Left            =   240
      TabIndex        =   16
      Top             =   3120
      Width           =   1200
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "ID:"
      Height          =   195
      Left            =   240
      TabIndex        =   15
      Top             =   2640
      Width           =   210
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "Subfamily:"
      Height          =   195
      Left            =   240
      TabIndex        =   14
      Top             =   2160
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Family:"
      Height          =   195
      Left            =   240
      TabIndex        =   13
      Top             =   1680
      Width           =   480
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Name:"
      Height          =   195
      Left            =   240
      TabIndex        =   12
      Top             =   120
      Width           =   465
   End
   Begin VB.Label lblVersion 
      BackColor       =   &H80000005&
      Caption         =   "lblVersion"
      ForeColor       =   &H80000008&
      Height          =   915
      Left            =   1560
      TabIndex        =   8
      Top             =   600
      Width           =   4455
   End
   Begin VB.Label lblTrademark 
      BackColor       =   &H80000005&
      Caption         =   "lblTrademark"
      ForeColor       =   &H80000008&
      Height          =   615
      Left            =   1560
      TabIndex        =   7
      Top             =   3600
      Width           =   4455
   End
   Begin VB.Label lblSubfamily 
      BackColor       =   &H80000005&
      Caption         =   "lblSubfamily"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1560
      TabIndex        =   6
      Top             =   2160
      Width           =   4455
   End
   Begin VB.Label lblPostscriptName 
      BackColor       =   &H80000005&
      Caption         =   "lblPostscriptName"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1560
      TabIndex        =   5
      Top             =   3120
      Width           =   4455
   End
   Begin VB.Label lblName 
      BackColor       =   &H80000005&
      Caption         =   "lblName"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1560
      TabIndex        =   4
      Top             =   120
      Width           =   4455
   End
   Begin VB.Label lblID 
      BackColor       =   &H80000005&
      Caption         =   "lblID"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1560
      TabIndex        =   3
      Top             =   2640
      Width           =   4455
   End
   Begin VB.Label lblFamily 
      BackColor       =   &H80000005&
      Caption         =   "lblFamily"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1560
      TabIndex        =   2
      Top             =   1680
      Width           =   4455
   End
   Begin VB.Label lblCopyright 
      BackColor       =   &H80000005&
      Caption         =   "lblCopyright"
      ForeColor       =   &H80000008&
      Height          =   915
      Left            =   1560
      TabIndex        =   1
      Top             =   4440
      Width           =   4455
   End
End
Attribute VB_Name = "frmFontInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private f As TtfInfoLib.FontInfo

Private Sub cmdInstall_Click()
    On Error GoTo err_Unexpected

    If f = "" Then
        MsgBox "Pick a font first"
        Exit Sub
    End If

    If f.RegisteredFileName <> "" Then
        MsgBox "A font with this name is already installed" & _
            vbCrLf & f.RegisteredFileName
        Exit Sub
    End If
    
    f.Install True
    Exit Sub
    
err_Unexpected:
    MsgBox Err.Description
End Sub

Private Sub cmdSelect_Click()
    On Error GoTo err_Cancel
        cdlFont.ShowOpen
    
    On Error GoTo err_Create
        Set f = New TtfInfoLib.FontInfo
    
    On Error GoTo err_FileName
    ' FileName is the default property
        f = cdlFont.filename
        
    On Error GoTo err_Unexpected
        With f
            Caption = "FontInfo - " & .filename
            
            lblCopyright = .Copyright
            lblFamily = .Family
            lblID = .ID
            lblName = .Name
            lblPostscriptName = .PostscriptName
            lblSubfamily = .Subfamily
            lblTrademark = .Trademark
            lblVersion = .Version
        End With
    
    Exit Sub


err_Create:
err_FileName:
err_Unexpected:
    MsgBox Err.Description
err_Cancel:
    Exit Sub
End Sub

Private Sub cmdUninstall_Click()
    On Error GoTo err_Unexpected

    If f.RegisteredFileName = "" Then
        MsgBox "This font is not installed"
        Exit Sub
    End If
    
    If f.RegisteredFileName <> f.filename Then
        MsgBox "The font that you have picked is installed, but a different file has been registered" _
            & vbCrLf & f.RegisteredFileName
        Exit Sub
    End If

    f.Uninstall True
    Exit Sub
    
err_Unexpected:
    MsgBox Err.Description
End Sub

Private Sub cmdView_Click()
    On Error GoTo err_Unexpected
    
    Dim frm As New frmFontView
    With frm
        Set .DisplayFont = f
        .Show
    End With
    Exit Sub
    
err_Unexpected:
    MsgBox Err.Description
End Sub

Private Sub Form_Load()
    On Error GoTo err_Unexpected

    Set f = New TtfInfoLib.FontInfo
    cdlFont.InitDir = f.GetFontsDirectory()
    Exit Sub
    
err_Unexpected:
    MsgBox Err.Description
End Sub