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