home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch1 / ListFont.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-09  |  3.1 KB  |  106 lines
  1. VERSION 5.00
  2. Begin VB.Form frmListFont 
  3.    Caption         =   "ListFont"
  4.    ClientHeight    =   4020
  5.    ClientLeft      =   2115
  6.    ClientTop       =   1215
  7.    ClientWidth     =   4455
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   4020
  11.    ScaleWidth      =   4455
  12.    Begin VB.ListBox lstPrinterFonts 
  13.       Height          =   3765
  14.       Left            =   2280
  15.       MultiSelect     =   2  'Extended
  16.       Sorted          =   -1  'True
  17.       TabIndex        =   1
  18.       Top             =   240
  19.       Width           =   2175
  20.    End
  21.    Begin VB.ListBox lstScreenFonts 
  22.       Height          =   3765
  23.       Left            =   0
  24.       MultiSelect     =   2  'Extended
  25.       Sorted          =   -1  'True
  26.       TabIndex        =   0
  27.       Top             =   240
  28.       Width           =   2175
  29.    End
  30.    Begin VB.Label Label1 
  31.       Alignment       =   2  'Center
  32.       Caption         =   "Printer Fonts"
  33.       Height          =   255
  34.       Index           =   1
  35.       Left            =   2280
  36.       TabIndex        =   3
  37.       Top             =   0
  38.       Width           =   2175
  39.    End
  40.    Begin VB.Label Label1 
  41.       Alignment       =   2  'Center
  42.       Caption         =   "Screen Fonts"
  43.       Height          =   255
  44.       Index           =   0
  45.       Left            =   0
  46.       TabIndex        =   2
  47.       Top             =   0
  48.       Width           =   2175
  49.    End
  50. Attribute VB_Name = "frmListFont"
  51. Attribute VB_GlobalNameSpace = False
  52. Attribute VB_Creatable = False
  53. Attribute VB_PredeclaredId = True
  54. Attribute VB_Exposed = False
  55. Option Explicit
  56. ' Load the font lists.
  57. Private Sub Form_Load()
  58. Dim i1 As Integer
  59. Dim i2 As Integer
  60. Dim tst As Integer
  61.     ' Prevent errors if the printer is offline.
  62.     On Error GoTo SkipPrinter
  63.     ' List the printer fonts.
  64.     For i1 = 0 To Printer.FontCount - 1
  65.         lstPrinterFonts.AddItem Printer.Fonts(i1)
  66.     Next i1
  67. SkipPrinter:
  68.     On Error GoTo 0
  69.     ' List the screen fonts.
  70.     For i2 = 0 To Screen.FontCount - 1
  71.         lstScreenFonts.AddItem Screen.Fonts(i2)
  72.     Next i2
  73.     ' Compare the items in the lists and
  74.     ' select any that are in one list but
  75.     ' missing in the other
  76.     i1 = 0
  77.     i2 = 0
  78.     Do While i1 < lstPrinterFonts.ListCount And _
  79.              i2 < lstScreenFonts.ListCount
  80.         tst = StrComp(lstPrinterFonts.List(i1), lstScreenFonts.List(i2))
  81.         If tst < 0 Then
  82.             ' Form font < Screen font
  83.             lstPrinterFonts.Selected(i1) = True
  84.             i1 = i1 + 1
  85.         ElseIf tst = 0 Then
  86.             ' They match
  87.             i1 = i1 + 1
  88.             i2 = i2 + 1
  89.         Else
  90.             ' Form font > Screen font
  91.             lstScreenFonts.Selected(i2) = True
  92.             i2 = i2 + 1
  93.         End If
  94.     Loop
  95.     Do While i1 < lstPrinterFonts.ListCount
  96.         lstPrinterFonts.Selected(i1) = True
  97.         i1 = i1 + 1
  98.     Loop
  99.     Do While i2 < lstScreenFonts.ListCount
  100.         lstScreenFonts.Selected(i2) = True
  101.         i2 = i2 + 1
  102.     Loop
  103.     lstPrinterFonts.TopIndex = 0
  104.     lstScreenFonts.TopIndex = 0
  105. End Sub
  106.