home *** CD-ROM | disk | FTP | other *** search
/ PC-Test Pro / PCTESTPRO.iso / video / qtest / entp / qstest.bas < prev    next >
Encoding:
BASIC Source File  |  1995-04-06  |  3.2 KB  |  98 lines
  1. Option Explicit
  2. DefInt A-Z
  3.  
  4. ' global constants
  5. Global Const KEY_HELP = &H2F
  6. Global Const KEY_ADD = &H6B
  7. Global Const KEY_SUBTRACT = &H6D
  8. Global Const KEY_UP = &H26
  9. Global Const KEY_DOWN = &H28
  10. Global Const KEY_F1 = &H70
  11. Global Const SHIFT_MASK = 1
  12. Global Const CTRL_MASK = 2
  13. Global Const ALT_MASK = 4
  14. Global Const MB_OK = 0
  15. Global Const HORIZONTAL = 1
  16. Global Const VERTICAL = 2
  17. Global Const WHITE = &HFFFFFF
  18. Global Const BLACK = 0
  19. Global Const RED = &HFF
  20. Global Const GREEN = &HFF000
  21. Global Const BLUE = &HFF0000
  22.  
  23. ' WhichPattern types
  24. Global Const FOCUS = 1
  25. Global Const GEOMETRY = 2
  26. Global Const CONVTEST = 3
  27. Global Const CONVADJUST = 4
  28. Global Const COLORTRACKING = 5
  29. Global Const PURITY = 6
  30.  
  31. ' global variables
  32. Global ShiftState As Integer   'is Shift key held down?
  33. Global WhichPattern As Integer 'current pattern
  34. Global NumCols As Integer      'number of columns for grid pattern
  35. Global FocusFont$                'for focus pattern
  36. Global FocusFontSize As Single  'for focus pattern
  37. Global TimeInterval As Integer   'convergence pattern flashing, in milliseconds
  38. Global NumberOfGrays As Integer  'number of gray bars for ColorTracking pattern
  39. Global ConvOrient As Integer     'orientation of convergence pattern
  40. Global FirstConvTest As Integer  'True if this is the first convergence test pattern shown
  41. Global OldPattern As Integer     'Holds previous pattern number
  42.  
  43. Sub CheckFont ()
  44.    
  45.    'This Sub makes sure the font used in help screens and
  46.    'the focus pattern exists on the system. If it doesn't
  47.    'exist, it tries to find a sans serif font. If it can't
  48.    'find one, it chooses the first font in the system list.
  49.    Dim Found, n As Integer
  50.    Dim F$   'holds the font name in upper-case
  51.    Found = False  'Found = True when font found on system
  52.    FocusFont$ = UCase$(FocusFont$)
  53.    
  54.    ' Does current Focus Font exist on the system?
  55.    For n = 0 To Screen.FontCount - 1
  56.       F$ = UCase$(Screen.Fonts(n))
  57.       If F$ = FocusFont$ Then
  58.          Found = True
  59.          FocusFont$ = Screen.Fonts(n)
  60.          Exit For
  61.       End If
  62.    Next n
  63.    
  64.    'If not Found, check for common sans serif true type fonts
  65.    If Found = False Then
  66.       For n = 0 To Screen.FontCount - 1
  67.          F$ = UCase$(Screen.Fonts(n))
  68.          'the next line prevents errors when checking string
  69.          If Len(F$) < 7 Then F$ = F$ + String$(7 - Len(F$), "!")
  70.          If Left$(F$, 5) = "ARIAL" Or Left$(F$, 4) = "HELV" Or Left$(F$, 5) = "SANSS" Or Left$(F$, 5) = "OPTIM" Or Left$(F$, 5) = "GILLS" Or Left$(F$, 5) = "AVANT" Or Left$(F$, 7) = "CENTURY" Then
  71.             Found = True
  72.             FocusFont$ = Screen.Fonts(n)
  73.             Exit For
  74.          End If
  75.       Next n
  76.    End If
  77.    
  78.    'If still not Found, check for ms sans serif
  79.    If Found = False Then
  80.       For n = 0 To Screen.FontCount - 1
  81.          F$ = UCase$(Screen.Fonts(n))
  82.          If Len(F$) < 7 Then F$ = F$ + String$(7 - Len(F$), "!")
  83.          If Left$(F$, 7) = "MS SANS" Then
  84.             Found = True
  85.             FocusFont$ = Screen.Fonts(n)
  86.             Exit For
  87.          End If
  88.       Next n
  89.    End If
  90.    
  91.    'If no ms sans serif font either, pick the first font.
  92.    If Found = False Then
  93.       FocusFont$ = Screen.Fonts(0)
  94.    End If
  95.  
  96. End Sub
  97.  
  98.