Programming Tool Box/SIMS_2.iso/vb_code1/fontview/fontview.txt

Text File | 1991-05-30 | 5KB | 194 lines

Dim ValChangeFlag As Integer
Dim CharChangeFlat As Integer
Dim OldValueText As String
Dim OldCharText As String

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 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 ColorList_Click ()
    ShowDisplayText
End Sub

Sub SizeList_Click ()
    ShowDisplayText
End Sub

Sub FontList_Click ()
    ckBold_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 Form_Unload (Cancel As Integer)
    End
End Sub

Sub Text1_LostFocus ()
    Text1.Text = RTrim$(Text1.Text) + " "
    ckItalic.Enabled = TRUE
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 cmdQuit_Click ()
    Unload FontViewer       ' Unload main form
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 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 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