Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/fontview/fontview.frm

Visual Basic Form | 1995-09-06 | 11.7 KB | 374 lines

VERSION 2.00
Begin Form FontViewer
   BackColor       =   &H00808000&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Font Viewer"
   ClientHeight    =   4275
   ClientLeft      =   1080
   ClientTop       =   1515
   ClientWidth     =   7155
   ForeColor       =   &H00FFFFFF&
   Height          =   4680
   Icon            =   FONTVIEW.FRX:0000
   Left            =   1020
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4275
   ScaleWidth      =   7155
   Top             =   1170
   Width           =   7275
   Begin TextBox Text1
      BackColor       =   &H00FFFFFF&
      Height          =   1455
      Left            =   195
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   2610
      Width           =   6705
   End
   Begin CommandButton cmdQuit
      Caption         =   "Quit"
      Height          =   1065
      Left            =   5850
      TabIndex        =   14
      Top             =   1245
      Width           =   1050
   End
   Begin Frame Frame2
      BackColor       =   &H00808000&
      Caption         =   "&Display Text"
      ForeColor       =   &H0000FFFF&
      Height          =   1248
      Left            =   3096
      TabIndex        =   1
      Top             =   1080
      Width           =   2520
      Begin TextBox SingleChar
         Height          =   396
         Left            =   1968
         TabIndex        =   18
         Text            =   "A"
         Top             =   720
         Width           =   444
      End
      Begin OptionButton DisplayText
         BackColor       =   &H00808000&
         Caption         =   "Custom"
         ForeColor       =   &H00FFFFFF&
         Height          =   300
         Index           =   1
         Left            =   216
         TabIndex        =   12
         Top             =   720
         Width           =   984
      End
      Begin OptionButton DisplayText
         BackColor       =   &H00808000&
         Caption         =   "Standard"
         ForeColor       =   &H00FFFFFF&
         Height          =   252
         Index           =   0
         Left            =   216
         TabIndex        =   10
         Top             =   360
         Width           =   1104
      End
      Begin TextBox SingleCharValue
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   372
         Left            =   1968
         TabIndex        =   9
         Text            =   "65"
         Top             =   240
         Width           =   444
      End
      Begin VScrollBar SingleCharSelect
         Height          =   948
         Left            =   1440
         Max             =   255
         TabIndex        =   8
         Top             =   216
         Value           =   65
         Width           =   300
      End
   End
   Begin Frame Frame1
      BackColor       =   &H00808000&
      Caption         =   "&Attributes"
      ForeColor       =   &H0000FFFF&
      Height          =   1248
      Left            =   216
      TabIndex        =   2
      Top             =   1080
      Width           =   2688
      Begin CheckBox ckUnderline
         BackColor       =   &H00808000&
         Caption         =   "Underline"
         ForeColor       =   &H00FFFFFF&
         Height          =   252
         Left            =   1152
         TabIndex        =   17
         Top             =   720
         Width           =   1212
      End
      Begin CheckBox ckItalic
         BackColor       =   &H00808000&
         Caption         =   "Italic"
         ForeColor       =   &H00FFFFFF&
         Height          =   360
         Left            =   210
         TabIndex        =   7
         Top             =   660
         Width           =   840
      End
      Begin CheckBox ckStrikeThrough
         BackColor       =   &H00808000&
         Caption         =   "Strikethrough"
         ForeColor       =   &H00FFFFFF&
         Height          =   228
         Left            =   1152
         TabIndex        =   16
         Top             =   360
         Width           =   1452
      End
      Begin CheckBox CkBold
         BackColor       =   &H00808000&
         Caption         =   "Bold"
         ForeColor       =   &H00FFFFFF&
         Height          =   285
         Left            =   210
         TabIndex        =   15
         Top             =   315
         Width           =   720
      End
   End
   Begin ComboBox ColorList
      BackColor       =   &H00E0FFFF&
      Height          =   288
      Left            =   4632
      Style           =   2  'Dropdown List
      TabIndex        =   13
      Top             =   612
      Width           =   2256
   End
   Begin ComboBox SizeList
      BackColor       =   &H00E0FFFF&
      Height          =   288
      Left            =   3408
      Style           =   2  'Dropdown List
      TabIndex        =   11
      Top             =   612
      Width           =   912
   End
   Begin ComboBox FontList
      BackColor       =   &H00E0E0E0&
      Height          =   288
      Left            =   216
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   6
      Top             =   576
      Width           =   2940
   End
   Begin Label Label3
      BackColor       =   &H00808000&
      Caption         =   "&Color"
      ForeColor       =   &H0000FFFF&
      Height          =   252
      Left            =   4632
      TabIndex        =   3
      Top             =   252
      Width           =   1572
   End
   Begin Label Label2
      BackColor       =   &H00808000&
      Caption         =   "&Size"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   3420
      TabIndex        =   4
      Top             =   255
      Width           =   750
   End
   Begin Label Label1
      BackColor       =   &H00808000&
      Caption         =   "&Font"
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   285
      TabIndex        =   5
      Top             =   210
      Width           =   1350
   End
Dim ValChangeFlag As Integer
Dim CharChangeFlat As Integer
Dim OldValueText As String
Dim OldCharText As String
Sub ckBold_Click ()
    If ckBold.Value = CHECKED Then
        Text1.FontBold = True
    Else
        Text1.FontBold = False
    End If
End Sub
Sub ckItalic_Click ()
   Text1.FontItalic = Not Text1.FontItalic  ' Toggle Italic
End Sub
Sub ckStrikeThrough_Click ()
    Text1.FontStrikethru = Not Text1.FontStrikethru     ' Toggle Strikethru
End Sub
Sub ckUnderline_Click ()
    Text1.FontUnderline = Not Text1.FontUnderline   ' Toggle Underline
End Sub
Sub cmdQuit_Click ()
    Unload FontViewer       ' Unload main form
End Sub
Sub ColorList_Click ()
    ShowDisplayText
End Sub
Sub DisplayText_Click (Index As Integer)
    Select Case Index
        Case 0
            DisplayText(Index + 1).Value = Not DisplayText(Index).Value
        Case 1
            DisplayText(Index - 1).Value = Not DisplayText(Index).Value
            Text1.Text = ""
            Text1.SetFocus
    End Select
    ShowDisplayText
End Sub
Sub FontList_Click ()
    ckBold_Click
    ShowDisplayText
End Sub
Sub Form_Load ()
    ' Initialize form position
    Left = (Screen.width - width) / 2
    Top = (Screen.Height - Height) / 2
    ' Initialize font list
    For I% = 0 To Screen.FontCount - 1
        FontList.AddItem Screen.Fonts(I%)
    Next I%
    ' Set default font
    FontList.ListIndex = 1
    For I% = 0 To FontList.ListCount
        If FontList.List(I%) = "Helv" Then
            FontList.ListIndex = I%
            Exit For
        End If
    Next I%
    'Initialize font size list
    For I% = 6 To 48 Step 2
        SizeList.AddItem Str$(I%)

    Next I%
    SizeList.ListIndex = 3
    ' Initialize colors
    ColorList.AddItem "0 - Black"
    ColorList.AddItem "1 - Blue"
    ColorList.AddItem "2 - Green"
    ColorList.AddItem "3 - Cyan"
    ColorList.AddItem "4 - Red"
    ColorList.AddItem "5 - Magenta"
    ColorList.AddItem "6 - Brown"
    ColorList.AddItem "7 - White"
    ColorList.AddItem "8 - Gray"
    ColorList.AddItem "9 - Light Blue"
    ColorList.AddItem "10 - Light Green"
    ColorList.AddItem "11 - Light Cyan"
    ColorList.AddItem "12 - Light Red"
    ColorList.AddItem "13 - Light Magenta"
    ColorList.AddItem "14 - Yellow"
    ColorList.AddItem "15 - Bright White"
    ColorList.ListIndex = 0
    ' Initialize font attributes OFF
    Text1.FontBold = False
    Text1.FontItalic = False
    Text1.FontStrikethru = False
    Text1.FontUnderline = False
    'Initialize Option buttons
    DisplayText(0).Value = True
    DisplayText(1).Value = False
    Text2Display$ = GetDisplayText()
    ShowDisplayText
End Sub
Sub Form_Unload (Cancel As Integer)
    End
End Sub
Function GetDisplayText$ ()
        For I% = 33 To 255                          ' Make the standard text to display
            ViewText$ = ViewText$ + Chr$(I%)
        Next I%
        ViewText$ = ViewText$ + " "                 ' Pad with space for Italic
        GetDisplayText$ = ViewText$
End Function
Sub ShowDisplayText ()
    Text1.FontName = FontList.Text                  ' Get the font name
    If Len(SizeList.Text) <> 0 Then Text1.FontSize = Val(SizeList.Text)             ' Get the font size
    Text1.ForeColor = QBColor(Val(ColorList.Text))  ' Get the foreground color
    If DisplayText(0).Value = True Then
        If Text1.Text <> Text2Display$ Then
            Text1.Text = Text2Display$
        Else
            Text1.Text = Text1.Text + " "
        End If
    Else
        Text1.Text = Text1.Text + " "
    End If
End Sub
Sub SingleChar_Change ()
    If Len(SingleChar.Text) = 0 Then SingleChar.Text = "A"
    If Asc(Left$(SingleChar.Text, 1)) >= 0 And Asc(Left$(SingleChar.Text, 1)) <= 255 Then
        CharChangeFlag = True
        SingleCharSelect.Value = Asc(SingleChar.Text)
        OldCharText$ = SingleChar.Text
    Else
        SingleChar.Text = OldCharText$
    End If
End Sub
Sub SingleCharSelect_Change ()
    SingleChar.Text = Chr$(SingleCharSelect.Value)
    SingleCharValue.Text = Format$(SingleCharSelect.Value)
    ValChangeFlag = False
    CharChangeFlag = False
End Sub
Sub SingleCharValue_Change ()
    If Len(SingleCharValue.Text) = 0 Then SingleCharValue.Text = "65"
    If Val(SingleCharValue.Text) >= 0 And Val(SingleCharValue.Text) <= 255 Then
        ValChangeFlag = True
        SingleCharSelect.Value = Val(SingleCharValue.Text)
        OldValueText$ = SingleCharValue.Text
    Else
        SingleCharValue.Text = OldValueText$
    End If
End Sub
Sub SizeList_Click ()
    ShowDisplayText
End Sub
Sub Text1_GotFocus ()
    If DisplayText(0).Value = True Then
        DisplayText(0).SetFocus
    Else
        ckItalic.Value = False
        ckItalic.Enabled = False
        Text1.FontItalic = False
    End If
End Sub
Sub Text1_KeyPress (KeyAscii As Integer)
    If DisplayText(1).Value = True Then
        ckItalic.Enabled = True
    End If
End Sub
Sub Text1_LostFocus ()
    Text1.Text = RTrim$(Text1.Text) + " "
    ckItalic.Enabled = True
End Sub