home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / fontsh13 / fontshow.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-03-17  |  28.1 KB  |  861 lines
  1. VERSION 2.00
  2. Begin Form Fontshow 
  3.    BackColor       =   &H00C0C000&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "FontShow 1.3"
  6.    ClientHeight    =   6396
  7.    ClientLeft      =   1848
  8.    ClientTop       =   468
  9.    ClientWidth     =   6960
  10.    FontBold        =   -1  'True
  11.    FontItalic      =   0   'False
  12.    FontName        =   "MS Sans Serif"
  13.    FontSize        =   7.8
  14.    FontStrikethru  =   0   'False
  15.    FontUnderline   =   -1  'True
  16.    ForeColor       =   &H00800000&
  17.    Height          =   6816
  18.    Left            =   1800
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    ScaleHeight     =   6396
  22.    ScaleWidth      =   6960
  23.    Top             =   96
  24.    Width           =   7056
  25.    Begin SSCheck ChkPara 
  26.       Caption         =   "&Text Paragraphs"
  27.       ForeColor       =   &H00C00000&
  28.       Height          =   252
  29.       Left            =   3720
  30.       TabIndex        =   12
  31.       Top             =   4080
  32.       Width           =   1692
  33.    End
  34.    Begin SSCheck ChkItalic 
  35.       Caption         =   "&Italic"
  36.       ForeColor       =   &H00800080&
  37.       Height          =   252
  38.       Left            =   5760
  39.       TabIndex        =   14
  40.       Top             =   3840
  41.       Width           =   732
  42.    End
  43.    Begin SSCheck ChkBold 
  44.       Caption         =   "&Bold"
  45.       ForeColor       =   &H00800080&
  46.       Height          =   252
  47.       Left            =   5760
  48.       TabIndex        =   13
  49.       Top             =   3600
  50.       Width           =   732
  51.    End
  52.    Begin SSCheck ChkFull 
  53.       Caption         =   "&Full Page Sample"
  54.       ForeColor       =   &H00C00000&
  55.       Height          =   252
  56.       Left            =   3720
  57.       TabIndex        =   11
  58.       Top             =   3840
  59.       Width           =   1692
  60.    End
  61.    Begin SSCheck ChkChart 
  62.       Caption         =   "&Character Chart"
  63.       ForeColor       =   &H00C00000&
  64.       Height          =   252
  65.       Left            =   3720
  66.       TabIndex        =   10
  67.       Top             =   3600
  68.       Width           =   1692
  69.    End
  70.    Begin SSCheck ChkSample 
  71.       Caption         =   "&Sample Text"
  72.       ForeColor       =   &H00C00000&
  73.       Height          =   252
  74.       Left            =   3720
  75.       TabIndex        =   9
  76.       Top             =   3360
  77.       Value           =   -1  'True
  78.       Width           =   1452
  79.    End
  80.    Begin SSPanel Panel3D3 
  81.       AutoSize        =   3  'AutoSize Child To Panel
  82.       BevelInner      =   1  'Inset
  83.       BorderWidth     =   1
  84.       Height          =   1212
  85.       Left            =   3600
  86.       Outline         =   -1  'True
  87.       TabIndex        =   22
  88.       Top             =   3240
  89.       Width           =   3012
  90.    End
  91.    Begin SSCommand CmdGrid 
  92.       Caption         =   "Display Font &Map"
  93.       ForeColor       =   &H00000080&
  94.       Height          =   372
  95.       Left            =   4920
  96.       TabIndex        =   7
  97.       Top             =   2280
  98.       Width           =   1692
  99.    End
  100.    Begin SSCommand CmdHeadFont 
  101.       Caption         =   "&Heading Font"
  102.       ForeColor       =   &H00000080&
  103.       Height          =   372
  104.       Left            =   4920
  105.       TabIndex        =   4
  106.       Top             =   840
  107.       Width           =   1692
  108.    End
  109.    Begin SSCommand CmdEdit 
  110.       Caption         =   "&Edit Sample Text"
  111.       ForeColor       =   &H00000080&
  112.       Height          =   372
  113.       Left            =   4920
  114.       TabIndex        =   5
  115.       Top             =   1320
  116.       Width           =   1692
  117.    End
  118.    Begin SpinButton SpinSampleSize 
  119.       BackColor       =   &H00FFFF80&
  120.       Delay           =   125
  121.       ForeColor       =   &H00000000&
  122.       Height          =   312
  123.       Left            =   6360
  124.       LightColor      =   &H00FFFF80&
  125.       ShadowBackColor =   &H00FFFF80&
  126.       SpinBackColor   =   &H00FFFF80&
  127.       Top             =   4800
  128.       Width           =   252
  129.    End
  130.    Begin SSPanel Panel3D2 
  131.       AutoSize        =   3  'AutoSize Child To Panel
  132.       BevelInner      =   1  'Inset
  133.       Caption         =   "Panel3D2"
  134.       Height          =   3984
  135.       Left            =   360
  136.       TabIndex        =   19
  137.       Top             =   480
  138.       Width           =   3012
  139.       Begin ListBox LstFonts 
  140.          Height          =   3864
  141.          Left            =   60
  142.          MultiSelect     =   2  'Extended
  143.          Sorted          =   -1  'True
  144.          TabIndex        =   1
  145.          Top             =   60
  146.          Width           =   2892
  147.       End
  148.    End
  149.    Begin SSPanel Panel3D1 
  150.       AutoSize        =   3  'AutoSize Child To Panel
  151.       BevelInner      =   1  'Inset
  152.       Caption         =   "Panel3D1"
  153.       Height          =   1092
  154.       Left            =   360
  155.       TabIndex        =   18
  156.       Top             =   5160
  157.       Width           =   6252
  158.       Begin TextBox TxtDispFont 
  159.          FontBold        =   0   'False
  160.          FontItalic      =   0   'False
  161.          FontName        =   "MS Sans Serif"
  162.          FontSize        =   12
  163.          FontStrikethru  =   0   'False
  164.          FontUnderline   =   0   'False
  165.          Height          =   972
  166.          Left            =   60
  167.          MultiLine       =   -1  'True
  168.          TabIndex        =   15
  169.          Top             =   60
  170.          Width           =   6132
  171.       End
  172.    End
  173.    Begin TextBox TxtPointSize 
  174.       BackColor       =   &H00C0C000&
  175.       Height          =   288
  176.       Left            =   5760
  177.       TabIndex        =   3
  178.       Text            =   "12"
  179.       Top             =   360
  180.       Width           =   612
  181.    End
  182.    Begin SpinButton SpinPointSize 
  183.       BackColor       =   &H00FFFF80&
  184.       Delay           =   125
  185.       ForeColor       =   &H00000000&
  186.       Height          =   288
  187.       Left            =   6360
  188.       LightColor      =   &H00FFFF80&
  189.       ShadowBackColor =   &H00FFFF80&
  190.       SpinBackColor   =   &H00FFFF80&
  191.       Top             =   360
  192.       Width           =   252
  193.    End
  194.    Begin SSCommand CmdExit 
  195.       Caption         =   "E&xit"
  196.       ForeColor       =   &H000000C0&
  197.       Height          =   612
  198.       Left            =   3600
  199.       TabIndex        =   2
  200.       Top             =   840
  201.       Width           =   972
  202.    End
  203.    Begin SSCommand CmdPrint 
  204.       Caption         =   "&Print"
  205.       ForeColor       =   &H00000080&
  206.       Height          =   372
  207.       Left            =   4920
  208.       TabIndex        =   8
  209.       Top             =   2760
  210.       Width           =   1692
  211.    End
  212.    Begin SSCommand CmdSelAll 
  213.       Caption         =   "Select &All"
  214.       ForeColor       =   &H00000080&
  215.       Height          =   372
  216.       Left            =   4920
  217.       TabIndex        =   6
  218.       Top             =   1800
  219.       Width           =   1692
  220.    End
  221.    Begin Label LabelFontsSel 
  222.       BackColor       =   &H00C0C000&
  223.       Caption         =   "Selected"
  224.       ForeColor       =   &H00000000&
  225.       Height          =   252
  226.       Left            =   2160
  227.       TabIndex        =   23
  228.       Top             =   240
  229.       Width           =   1332
  230.    End
  231.    Begin Label LblHeadingFont 
  232.       AutoSize        =   -1  'True
  233.       BackColor       =   &H00C0C000&
  234.       Caption         =   "Heading Font:"
  235.       Height          =   192
  236.       Left            =   360
  237.       TabIndex        =   21
  238.       Top             =   4560
  239.       Width           =   1176
  240.    End
  241.    Begin Label LblSampleSize 
  242.       BackColor       =   &H00C0C000&
  243.       Caption         =   "Sample size"
  244.       Height          =   252
  245.       Left            =   5160
  246.       TabIndex        =   20
  247.       Top             =   4920
  248.       Width           =   1128
  249.    End
  250.    Begin Label LblSample 
  251.       AutoSize        =   -1  'True
  252.       BackColor       =   &H00C0C000&
  253.       Caption         =   "Sample"
  254.       ForeColor       =   &H00000000&
  255.       Height          =   300
  256.       Left            =   360
  257.       TabIndex        =   17
  258.       Top             =   4920
  259.       Width           =   648
  260.    End
  261.    Begin Label LblFonts 
  262.       BackColor       =   &H00C0C000&
  263.       Caption         =   "Fonts"
  264.       ForeColor       =   &H00000000&
  265.       Height          =   252
  266.       Left            =   360
  267.       TabIndex        =   16
  268.       Top             =   240
  269.       Width           =   972
  270.    End
  271.    Begin Label LblPointSize 
  272.       BackColor       =   &H00C0C000&
  273.       Caption         =   "Sample Text Point Si&ze"
  274.       ForeColor       =   &H00000000&
  275.       Height          =   420
  276.       Left            =   4560
  277.       TabIndex        =   0
  278.       Top             =   240
  279.       Width           =   1212
  280.       WordWrap        =   -1  'True
  281.    End
  282. Sub ChkBold_Click (Value As Integer)
  283.     TxtDispFont.FontBold = ChkBold
  284. End Sub
  285. Sub ChkItalic_Click (Value As Integer)
  286.     TxtDispFont.FontItalic = ChkItalic
  287. End Sub
  288. Sub CmdEdit_Click ()
  289.     FS_Edtxt.Show
  290. End Sub
  291. Sub CmdExit_Click ()
  292. End Sub
  293. Sub CmdGrid_Click ()
  294.     Screen.MousePointer = 11   ' hourglass
  295.     FS_Grid.Caption = CurrFont$
  296.     FS_Grid.Grid1.Width = 8470
  297.     FS_Grid.Grid1.Height = 2540
  298.     FS_Grid.Grid1.FontName = CurrFont$
  299.     FS_Grid.Grid1.FontBold = False
  300.     FS_Grid.Grid1.FontItalic = False
  301.     FS_Grid.ChkBold = False
  302.     FS_Grid.ChkItalic = False
  303.     FS_Grid.Grid1.FontSize = 11
  304.     For x% = 0 To 31
  305.         FS_Grid.Grid1.ColWidth(x%) = 250
  306.         FS_Grid.Grid1.ColAlignment(x%) = 2 'center
  307.     Next
  308.     For r% = 0 To 6
  309.         FS_Grid.Grid1.RowHeight(r%) = 350
  310.         FS_Grid.Grid1.Row = r%
  311.         For c% = 0 To 31
  312.             FS_Grid.Grid1.Col = c%
  313.             FS_Grid.Grid1 = Chr$(c% + ((r% + 1) * 32))
  314.         Next
  315.     Next
  316.     FS_Grid.Grid1.Row = 1
  317.     FS_Grid.Grid1.Col = 1
  318.     FS_Grid.TxtCurrChar.FontSize = 24
  319.     FS_Grid.TxtCurrChar.FontName = CurrFont$
  320.     FS_Grid.TxtCurrChar.FontBold = False
  321.     FS_Grid.TxtCurrChar.FontItalic = False
  322.     FS_Grid.TxtCurrChar = "A"
  323.     FS_Grid.Show
  324.     Screen.MousePointer = 0  ' normal
  325. End Sub
  326. Sub CmdHeadFont_Click ()
  327.     ' Code 4 is a Yes/No message box; result of 6 is a Yes response
  328.     mb = MsgBox("Change heading font to " + LstFonts.List(LstFonts.ListIndex) + "?", 4, "Heading Font")
  329.     If mb = 6 Then
  330.         HeadingFont$ = LstFonts.List(LstFonts.ListIndex)
  331.         x% = WritePrivateProfileString("Fontshow", "HeadingFont", HeadingFont$, IniFile)
  332.         LblHeadingFont.Caption = "Heading Font: " + HeadingFont$
  333.     End If
  334. End Sub
  335. Sub CmdPrint_Click ()
  336.     On Error GoTo PRINT_ERR
  337.     Dim i, j, P, n, m, mb, PerPage, printed As Integer
  338.     Dim PointSize As Single, ParaSize As Single, px As Single, py As Single
  339.     Static SampleText(3) As String
  340.     SampleText$(1) = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  341.     SampleText$(2) = "abcdefghijklmnopqrstuvwxyz1234567890!@#$%^&*()-+=[]{}/':;" + Chr$(34) + ",.?"
  342.     SampleText$(3) = FS_Edtxt.TxtSample
  343.     ContPrint = True
  344.     PointSize! = Val(TxtPointSize)
  345.     If PointSize! > 72 Then PointSize! = 72
  346.     ' 660 points is total available space (about 9.15 inches)
  347.     ' 24 points in between is 10 for blank line, 10 for heading, 4 to spare
  348.     PerPage = Int(660 / ((PointSize! * 3) + 24))
  349.     If PerPage > 14 Then PerPage = 14   ' avoid overflow
  350.     If ChkSample = False And ChkChart = False And ChkFull = False And ChkPara = False Then
  351.         mb = MsgBox("You have not selected any printing options", 48, "FontShow Error")
  352.         ChkSample.SetFocus
  353.         Exit Sub
  354.     End If
  355.     ' Display the paragraph size window before any printing is done;
  356.     ' in case they choose more than one printout we don't want it
  357.     ' interrupting the printing.
  358.     If ChkPara = True Then
  359.         DoPara = True
  360.         Fs_Psize.Show 1  ' 1 indicates modal
  361.     End If
  362.     FS_Prmsg.TxtPrintMsg = ""   ' clear out message box
  363.     If ChkSample = True Then
  364.         PageHead (PointSize!)
  365.         FS_Prmsg.Show
  366.         printed = 0
  367.         P = 1
  368.         For i = 0 To NumFonts - 1
  369.             DoEvents
  370.             If ContPrint = False Then Exit For
  371.             If LstFonts.Selected(i) = True Then
  372.                 printed = printed + 1
  373.                 CurrFont$ = LstFonts.List(i)
  374.                 FS_Prmsg.TxtPrintMsg = "Fonts Selected: " + Str$(FontsSel) + CRLF + "Samples printed: " + Str$(printed)
  375.                 Printer.FontName = HeadingFont$
  376.                 Printer.FontSize = 10
  377.                 Printer.FontBold = False
  378.                 Printer.FontItalic = False
  379.                 Printer.CurrentX = .5
  380.                 Printer.Print CurrFont$
  381.                 Printer.FontName = CurrFont$
  382.                 Printer.FontSize = PointSize!
  383.                 Printer.FontBold = ChkBold
  384.                 Printer.FontItalic = ChkItalic
  385.                 For j = 1 To 3
  386.                     Printer.CurrentX = .5
  387.                     Printer.Print SampleText$(j)
  388.                 Next
  389.                 Printer.FontSize = 10
  390.                 P = P + 1
  391.                 If P = PerPage Then
  392.                     P = 1
  393.                     Printer.NewPage
  394.                     Printer.EndDoc
  395.                     PageHead (PointSize!)
  396.                 Else
  397.                     Printer.Print  ' blank line between fonts
  398.                 End If
  399.             End If
  400.         Next
  401.     Printer.EndDoc
  402.     End If
  403.     If ChkChart = True Then
  404.         FS_Prmsg.Show
  405.         printed = 0
  406.         P = 1
  407.         For i = 0 To NumFonts - 1
  408.             DoEvents
  409.             If ContPrint = False Then Exit For
  410.             If LstFonts.Selected(i) = True Then
  411.                 Printer.ScaleMode = 5
  412.                 printed = printed + 1
  413.                 CurrFont$ = LstFonts.List(i)
  414.                 FS_Prmsg.TxtPrintMsg = "Fonts Selected: " + Str$(FontsSel) + CRLF + "Charts printed: " + Str$(printed)
  415.                 Printer.FontBold = False
  416.                 Printer.FontItalic = False
  417.                 Printer.FontName = HeadingFont$
  418.                 Printer.FontSize = 12
  419.                 BI$ = IIf(ChkBold = True And ChkItalic = True, " - Bold Italic", IIf(ChkBold = True And ChkItalic = False, " - Bold", IIf(ChkBold = False And ChkItalic = True, " - Italic", "")))
  420.                 Printer.CurrentX = 4 - (Printer.TextWidth(CurrFont$ + BI$) / 2)
  421.                 Printer.CurrentY = .5
  422.                 Printer.Print CurrFont$ + BI$;
  423.                 py! = .7
  424.                 For n = 33 To 243 Step 14
  425.                     px! = .25
  426.                     py! = py! + .4
  427.                     Printer.CurrentY = py!
  428.                     Printer.FontName = HeadingFont$
  429.                     Printer.FontBold = False
  430.                     Printer.FontItalic = False
  431.                     Printer.FontSize = 7
  432.                     For m = n To n + 13
  433.                         px! = px! + .5
  434.                         Printer.CurrentX = px!
  435.                         If m >= 33 And m <= 126 Then
  436.                             Printer.Print LTrim$(Str$(m)) + " " + Chr$(m);
  437.                         End If
  438.                         If m >= 127 And m <= 255 Then
  439.                             Printer.Print LTrim$(Str$(m));
  440.                         End If
  441.                     Next
  442.                     Printer.FontName = CurrFont$
  443.                     Printer.FontSize = 16
  444.                     Printer.FontBold = ChkBold
  445.                     Printer.FontItalic = ChkItalic
  446.                     px! = .28
  447.                     py! = py! + .15
  448.                     Printer.CurrentY = py!
  449.                     For m = n To n + 13
  450.                         px! = px! + .5
  451.                         Printer.CurrentX = px!
  452.                         If m < 256 Then Printer.Print Chr$(m);   ' chr$(256) doesn't exist
  453.                     Next
  454.                 Next
  455.                 Printer.NewPage
  456.                 Printer.EndDoc
  457.             End If
  458.         Next
  459.     End If
  460.     If ChkFull = True Then
  461.         FS_Prmsg.Show
  462.         printed = 0
  463.         P = 1
  464.         For i = 0 To NumFonts - 1
  465.             DoEvents
  466.             If ContPrint = False Then Exit For
  467.             If LstFonts.Selected(i) = True Then
  468.                 Printer.ScaleMode = 5
  469.                 printed = printed + 1
  470.                 CurrFont$ = LstFonts.List(i)
  471.                 FS_Prmsg.TxtPrintMsg = "Fonts Selected: " + Str$(FontsSel) + CRLF + "Full pages printed: " + Str$(printed)
  472.                 Printer.FontBold = False
  473.                 Printer.FontItalic = False
  474.                 Printer.FontName = HeadingFont$
  475.                 Printer.FontSize = 12
  476.                 Printer.CurrentX = .5
  477.                 Printer.CurrentY = .3
  478.                 Printer.Print CurrFont$;
  479.                 Printer.FontName = CurrFont$
  480.                 ' Samples from 8 to 60 points
  481.                 Printer.CurrentY = .7
  482.                 Printer.CurrentX = .5
  483.                 Printer.FontSize = 8
  484.                 Printer.Print FS_Edtxt.Txt8Pt
  485.                 Printer.CurrentX = .5
  486.                 Printer.FontSize = 9
  487.                 Printer.Print FS_Edtxt.Txt9Pt
  488.                 Printer.CurrentX = .5
  489.                 Printer.FontSize = 10
  490.                 Printer.Print FS_Edtxt.Txt10Pt
  491.                 Printer.CurrentX = .5
  492.                 Printer.FontSize = 11
  493.                 Printer.Print FS_Edtxt.Txt11Pt
  494.                 Printer.CurrentX = .5
  495.                 Printer.FontSize = 12
  496.                 Printer.Print FS_Edtxt.Txt12Pt
  497.                 Printer.CurrentX = .5
  498.                 Printer.FontSize = 14
  499.                 Printer.Print FS_Edtxt.Txt14Pt
  500.                 Printer.CurrentX = .5
  501.                 Printer.FontSize = 16
  502.                 Printer.Print FS_Edtxt.Txt16Pt
  503.                 Printer.CurrentX = .5
  504.                 Printer.CurrentX = .5
  505.                 Printer.FontSize = 18
  506.                 Printer.Print FS_Edtxt.Txt18Pt
  507.                 Printer.CurrentX = .5
  508.                 Printer.FontSize = 24
  509.                 Printer.Print FS_Edtxt.Txt24Pt
  510.                 Printer.CurrentX = .5
  511.                 Printer.FontSize = 36
  512.                 Printer.Print FS_Edtxt.Txt36Pt
  513.                 Printer.CurrentX = .5
  514.                 Printer.FontSize = 48
  515.                 Printer.Print FS_Edtxt.Txt48Pt
  516.                 Printer.CurrentX = .5
  517.                 Printer.FontSize = 60
  518.                 Printer.Print FS_Edtxt.Txt60Pt
  519.                 ' Normal text sample
  520.                 Printer.FontName = HeadingFont$
  521.                 Printer.FontSize = 10
  522.                 Printer.Print
  523.                 Printer.CurrentX = .5
  524.                 Printer.Print "Normal"
  525.                 Printer.FontName = CurrFont$
  526.                 Printer.FontSize = 12
  527.                 For j = 1 To 3
  528.                     Printer.CurrentX = .5
  529.                     Printer.Print SampleText$(j)
  530.                 Next
  531.                 ' Bold sample
  532.                 Printer.FontName = HeadingFont$
  533.                 Printer.FontSize = 10
  534.                 Printer.Print
  535.                 Printer.CurrentX = .5
  536.                 Printer.Print "Bold"
  537.                 Printer.FontName = CurrFont$
  538.                 Printer.FontBold = True
  539.                 Printer.FontSize = 12
  540.                 For j = 1 To 3
  541.                     Printer.CurrentX = .5
  542.                     Printer.Print SampleText$(j)
  543.                 Next
  544.                 ' Italic sample
  545.                 Printer.FontName = HeadingFont$
  546.                 Printer.FontSize = 10
  547.                 Printer.FontBold = False    ' turn it off for the heading
  548.                 Printer.Print
  549.                 Printer.CurrentX = .5
  550.                 Printer.Print "Italic"
  551.                 Printer.FontName = CurrFont$
  552.                 Printer.FontItalic = True
  553.                 Printer.FontSize = 12
  554.                 Printer.CurrentX = .5
  555.                 For j = 1 To 3
  556.                     Printer.CurrentX = .5
  557.                     Printer.Print SampleText$(j)
  558.                 Next
  559.                 ' Bold italic sample
  560.                 Printer.FontName = HeadingFont$
  561.                 Printer.FontSize = 10
  562.                 Printer.FontItalic = False  ' turn it off for the heading
  563.                 Printer.Print
  564.                 Printer.CurrentX = .5
  565.                 Printer.Print "Bold Italic"
  566.                 Printer.FontName = CurrFont$
  567.                 Printer.FontBold = True
  568.                 Printer.FontItalic = True
  569.                 Printer.FontSize = 12
  570.                 For j = 1 To 3
  571.                     Printer.CurrentX = .5
  572.                     Printer.Print SampleText$(j)
  573.                 Next
  574.                 ' Extended characters
  575.                 Printer.FontName = HeadingFont$
  576.                 Printer.FontSize = 10
  577.                 Printer.Print
  578.                 Printer.CurrentX = .5
  579.                 Printer.FontBold = False
  580.                 Printer.FontItalic = False
  581.                 Printer.Print "Extended Characters"
  582.                 Printer.FontName = CurrFont$
  583.                 Printer.FontSize = 12
  584.                 Printer.CurrentX = .5
  585.                 For j = 127 To 158
  586.                     Printer.Print Chr$(j) + " ";
  587.                 Next
  588.                 Printer.Print
  589.                 Printer.CurrentX = .5
  590.                 For j = 159 To 190
  591.                     Printer.Print Chr$(j) + " ";
  592.                 Next
  593.                 Printer.Print
  594.                 Printer.CurrentX = .5
  595.                 For j = 191 To 222
  596.                     Printer.Print Chr$(j) + " ";
  597.                 Next
  598.                 Printer.Print
  599.                 Printer.CurrentX = .5
  600.                 For j = 223 To 255
  601.                     Printer.Print Chr$(j) + " ";
  602.                 Next
  603.                 Printer.Print
  604.                 Printer.NewPage
  605.                 Printer.EndDoc
  606.             End If
  607.         Next
  608.     End If
  609.     If ChkPara = True Then
  610.         Static TextLine(6) As String
  611.         If DoPara = False Then
  612.             FS_Prmsg.Hide  ' in case it was displayed for another printout
  613.             Exit Sub
  614.         End If
  615.         FS_Prmsg.Show
  616.         TextLine$(1) = "When Gutenberg printed his 42-line Bible in 1456, he had only one typeface to choose"
  617.         TextLine$(2) = "from: the formal, square-text Gothic letter that mimicked the lettering of scribes."
  618.         TextLine$(3) = "Today, designers and desktop publishers have tens of thousands of typefaces to choose"
  619.         TextLine$(4) = "from, and new designs are added almost daily. Typefaces can be organized according to"
  620.         TextLine$(5) = "a simplified classification system which is based on the internationally recognized"
  621.         TextLine$(6) = "scheme that has been adopted by the Association Typeographique International."
  622.         printed = 0
  623.         P = 1
  624.         For i = 0 To NumFonts - 1
  625.             DoEvents
  626.             If ContPrint = False Then Exit For
  627.             If LstFonts.Selected(i) = True Then
  628.                 Printer.ScaleMode = 5
  629.                 printed = printed + 1
  630.                 CurrFont$ = LstFonts.List(i)
  631.                 FS_Prmsg.TxtPrintMsg = "Fonts Selected: " + Str$(FontsSel) + CRLF + "Paragraph pages printed: " + Str$(printed)
  632.                 Printer.FontBold = False
  633.                 Printer.FontItalic = False
  634.                 Printer.FontName = HeadingFont$
  635.                 Printer.FontSize = 12
  636.                 BI$ = IIf(ChkBold = True And ChkItalic = True, " - Bold Italic", IIf(ChkBold = True And ChkItalic = False, " - Bold", IIf(ChkBold = False And ChkItalic = True, " - Italic", "")))
  637.                 Printer.CurrentX = 4 - (Printer.TextWidth(CurrFont$ + BI$) / 2)
  638.                 Printer.CurrentY = .3
  639.                 Printer.Print CurrFont$ + BI$;
  640.                 Printer.Print
  641.                 For j = 0 To 12
  642.                     If Fs_Psize.ChkParaSize(j) = True Then
  643.                     ParaSize = Val(Fs_Psize.ChkParaSize(j).Caption)
  644.                     Printer.FontName = HeadingFont$
  645.                     Printer.FontSize = 11
  646.                     Printer.Print
  647.                     Printer.FontBold = False
  648.                     Printer.FontItalic = False
  649.                     Printer.CurrentX = .5
  650.                     Printer.Print ParaSize; "point"
  651.                     Printer.FontName = CurrFont$
  652.                     Printer.FontBold = ChkBold
  653.                     Printer.FontItalic = ChkItalic
  654.                     Printer.FontSize = ParaSize
  655.                     For m = 1 To 6
  656.                         Printer.CurrentX = .5
  657.                         Printer.Print TextLine$(m)
  658.                     Next
  659.                     End If
  660.                 Next
  661.                 Printer.NewPage
  662.                 Printer.EndDoc
  663.             End If
  664.         Next
  665.     End If
  666. PRINT_RESUME:
  667.     Printer.EndDoc
  668.     FS_Prmsg.Hide
  669.     Exit Sub
  670. PRINT_ERR:
  671.     If Err = 6 Then  ' overflow
  672.         mb = MsgBox("Overflow error while printing - point size too large" + CRLF + "Printing will be aborted", 48, "FontShow Error")
  673.     Else
  674.         mb = MsgBox("Error while printing -" + CRLF + Error$(Err), 48, "FontShow Error")
  675.     End If
  676.     Resume PRINT_RESUME
  677. End Sub
  678. Sub CmdSelAll_Click ()
  679.     RefreshSample = False
  680.     LstFonts.Visible = False
  681.     For i% = 0 To NumFonts - 1
  682.         LstFonts.Selected(i%) = True
  683.     Next
  684.     FontsSel = NumFonts
  685.     LabelFontsSel.Caption = "Selected: " + LTrim$(Str$(FontsSel))
  686.     RefreshSample = True
  687.     LstFonts.Visible = True
  688. End Sub
  689. Sub Form_Load ()
  690.     Dim TempFont As String
  691.     Dim i, HfontOK As Integer
  692.     Top = 350
  693.     Left = (Screen.Width - Width) / 2
  694.     IniFile$ = App.Path + "\FONTSHOW.INI"
  695.     If Len(Dir$(IniFile$)) = 0 Then
  696.         Open IniFile$ For Output As #1
  697.         Print #1, "[Fontshow]"
  698.         Print #1, "Def8=This is 8-point type - not easy to read!"
  699.         Print #1, "Def9=9-point type is about the smallest readable size."
  700.         Print #1, "Def10=Now, with 10-point type, we have a normal text size."
  701.         Print #1, "Def11=11-point type is usually ideal for body text."
  702.         Print #1, "Def12=With some fonts, 12-point type is easier to read."
  703.         Print #1, "Def14=14-point type is good for subheadings."
  704.         Print #1, "Def16=For larger subheadings, try 16-point type."
  705.         Print #1, "Def18=18-point type makes nice small headlines."
  706.         Print #1, "Def24=24-point type is for medium headlines."
  707.         Print #1, "Def36=36-point is for larger ones."
  708.         Print #1, "Def48=48-point almost shouts!"
  709.         Print #1, "Def60=60-point is huge!"
  710.         Print #1, "DefSample=The quick brown fox jumps over the lazy dog."
  711.         Print #1, "HeadingFont=Arial"
  712.         Close #1
  713.     End If
  714.     Def8$ = Space$(50)
  715.     Def9$ = Space$(50)
  716.     Def10$ = Space$(50)
  717.     Def11$ = Space$(50)
  718.     Def12$ = Space$(50)
  719.     Def14$ = Space$(50)
  720.     Def16$ = Space$(50)
  721.     Def18$ = Space$(50)
  722.     Def24$ = Space$(50)
  723.     Def36$ = Space$(50)
  724.     Def48$ = Space$(50)
  725.     Def60$ = Space$(50)
  726.     DefSample$ = Space$(50)
  727.     HeadingFont$ = Space$(50)
  728.     x% = GetPrivateProfileString("Fontshow", "Def8", "", Def8$, 50, IniFile)
  729.     x% = GetPrivateProfileString("Fontshow", "Def9", "", Def9$, 50, IniFile)
  730.     x% = GetPrivateProfileString("Fontshow", "Def10", "", Def10$, 50, IniFile)
  731.     x% = GetPrivateProfileString("Fontshow", "Def11", "", Def11$, 50, IniFile)
  732.     x% = GetPrivateProfileString("Fontshow", "Def12", "", Def12$, 50, IniFile)
  733.     x% = GetPrivateProfileString("Fontshow", "Def14", "", Def14$, 50, IniFile)
  734.     x% = GetPrivateProfileString("Fontshow", "Def16", "", Def16$, 50, IniFile)
  735.     x% = GetPrivateProfileString("Fontshow", "Def18", "", Def18$, 50, IniFile)
  736.     x% = GetPrivateProfileString("Fontshow", "Def24", "", Def24$, 50, IniFile)
  737.     x% = GetPrivateProfileString("Fontshow", "Def36", "", Def36$, 50, IniFile)
  738.     x% = GetPrivateProfileString("Fontshow", "Def48", "", Def48$, 50, IniFile)
  739.     x% = GetPrivateProfileString("Fontshow", "Def60", "", Def60$, 50, IniFile)
  740.     x% = GetPrivateProfileString("Fontshow", "DefSample", "", DefSample$, 50, IniFile)
  741.     x% = GetPrivateProfileString("Fontshow", "HeadingFont", "Arial", HeadingFont$, 50, IniFile)
  742.     HfontOK = False
  743.     CRLF = Chr$(13) + Chr$(10)
  744.     NumFonts = Printer.FontCount
  745.     ' Determine number of fonts and make sure heading font in INI file exists
  746.     For i = 0 To NumFonts - 1
  747.         TempFont$ = Printer.Fonts(i)
  748.         LstFonts.AddItem TempFont$ ' Put each font into list box.
  749.         If HfontOK = False Then  ' don't bother with this if already found
  750.             If InStr(1, TempFont$, Left$(HeadingFont$, Len(TempFont$)), 1) > 0 Then HfontOK = True
  751.         End If
  752.     Next i
  753.     If HfontOK = False Then
  754.         For i = 0 To NumFonts - 1
  755.             TempFont$ = Printer.Fonts(i)
  756.             If InStr(1, TempFont$, "courier", 1) = 0 And InStr(1, TempFont$, "line", 1) = 0 Then
  757.                 HeadingFont$ = TempFont$
  758.                 x% = WritePrivateProfileString("Fontshow", "HeadingFont", HeadingFont$, IniFile)
  759.                 Exit For
  760.             End If
  761.         Next
  762.     End If
  763.     LblHeadingFont.Caption = "Heading Font: " + HeadingFont$
  764.     TxtPointSize = "12.0"
  765.     RefreshSample = True
  766.     RefreshDefault = True
  767.     SampleChanged = False
  768.     TxtDispFont.FontSize = 12
  769.     FS_Edtxt.Txt8Pt = Def8$
  770.     FS_Edtxt.Txt9Pt = Def9$
  771.     FS_Edtxt.Txt10Pt = Def10$
  772.     FS_Edtxt.Txt11Pt = Def11$
  773.     FS_Edtxt.Txt12Pt = Def12$
  774.     FS_Edtxt.Txt14Pt = Def14$
  775.     FS_Edtxt.Txt16Pt = Def16$
  776.     FS_Edtxt.Txt18Pt = Def18$
  777.     FS_Edtxt.Txt24Pt = Def24$
  778.     FS_Edtxt.Txt36Pt = Def36$
  779.     FS_Edtxt.Txt48Pt = Def48$
  780.     FS_Edtxt.Txt60Pt = Def60$
  781.     FS_Edtxt.TxtSample = DefSample$
  782.     LblFonts.Caption = "Fonts: " + LTrim$(Str$(NumFonts))
  783.     ' Select first font and display sample text
  784.     LstFonts.Selected(0) = True
  785.     LstFonts_Click
  786. End Sub
  787. Sub LstFonts_Click ()
  788. ' An error will occur if the user clicks on a
  789. ' resident printer font such as Line Printer.
  790.     If RefreshSample = True Then
  791.         On Error GoTo LSTFONTS_ERR
  792.         CurrFont$ = LstFonts.List(LstFonts.ListIndex)
  793.         TxtDispFont.FontName = CurrFont$
  794.         'It's necessary to reset the bold and italic to match the check box
  795.         'because fonts whose regular version is bold or italic (true of some
  796.         'display and script fonts) will change it.
  797.         TxtDispFont.FontBold = ChkBold
  798.         TxtDispFont.FontItalic = ChkItalic
  799.         LblSample.Caption = "Sample: " + CurrFont$ + " (" + Format$(TxtDispFont.FontSize, "##") + " pt)"
  800.         FontsSel = SendMessage(LstFonts.hWnd, LB_GETSELCOUNT, 0, 0)
  801.         LabelFontsSel.Caption = "Selected: " + LTrim$(Str$(FontsSel))
  802.         If SampleChanged = False Then
  803.             TxtDispFont = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + CRLF + FS_Edtxt.TxtSample
  804.         End If
  805. LSTFONTS_RESUME:
  806.         Exit Sub
  807. LSTFONTS_ERR:
  808.         LblSample.Caption = "Sample: " + CurrFont$
  809.         TxtDispFont.FontName = "System"
  810.         TxtDispFont = CurrFont$ + " does not have an equivalent" + CRLF + "screen font and cannot be displayed."
  811.         GoTo LSTFONTS_RESUME
  812.     End If
  813. End Sub
  814. Sub PageHead (PointSize As Single)
  815.     ' ScaleMode must be reset every time a new page is printed, otherwise it may go back
  816.     ' to the default.  The reason for this is not clear.
  817.     Printer.ScaleMode = 5   'set to inches
  818.     Printer.FontName = HeadingFont$
  819.     Printer.FontSize = 10
  820.     Printer.Print
  821.     Printer.Print
  822.     Printer.CurrentX = .5
  823.     Printer.Print FS_Edtxt.TxtTitle;
  824.     SizeStyleText$ = IIf(ChkBold = True, "Bold ", "") + IIf(ChkItalic = True, "Italic", "") + "    Size: " + Format$(PointSize!, "##.0") + " points"
  825.     Printer.CurrentX = 7.5 - Printer.TextWidth(SizeStyleText$)
  826.     Printer.Print SizeStyleText$
  827.     Printer.Print
  828.     Printer.Print
  829. End Sub
  830. Sub SpinPointSize_SpinDown ()
  831.     TxtPointSize = LTrim$(Str$(Val(TxtPointSize) - 1))
  832.     If Val(TxtPointSize) < 6 Then TxtPointSize = "6"
  833. End Sub
  834. Sub SpinPointSize_SpinUp ()
  835.     TxtPointSize = LTrim$(Str$(Val(TxtPointSize) + 1))
  836. End Sub
  837. Sub SpinSampleSize_SpinDown ()
  838.     TxtDispFont.FontSize = TxtDispFont.FontSize - 1
  839.     If TxtDispFont.FontSize < 8 Then TxtDispFont.FontSize = 8
  840.     LstFonts_Click
  841. End Sub
  842. Sub SpinSampleSize_SpinUp ()
  843.     TxtDispFont.FontSize = TxtDispFont.FontSize + 1
  844.     If TxtDispFont.FontSize > 20 Then TxtDispFont.FontSize = 20
  845.     LstFonts_Click
  846. End Sub
  847. Sub TxtDispFont_LostFocus ()
  848.     SampleChanged = True
  849. End Sub
  850. Sub TxtPointSize_KeyPress (Keyascii As Integer)
  851.     ' Allow only digits, decimal point and backspace.
  852.     ' This works better than the masked edit control,
  853.     ' which handles decimal points very badly.
  854.     If (Keyascii < 48 And Keyascii <> 46 And Keyascii <> 8) Or Keyascii > 57 Then Keyascii = 0
  855. End Sub
  856. Sub TxtPointSize_LostFocus ()
  857.     If Val(TxtPointSize) > 72 Then TxtPointSize = "72"
  858.     If Val(TxtPointSize) <= 0 Then TxtPointSize = "12"
  859.     If Val(TxtPointSize) <= 4 Then TxtPointSize = "4"
  860. End Sub
  861.