home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol12n07.zip / HICOLO.BAS < prev    next >
BASIC Source File  |  1993-03-12  |  2KB  |  106 lines
  1. DEFINT A-Z
  2.  
  3. '$INCLUDE: 'QB.BI'
  4.  
  5. DECLARE SUB FPrint (Text$, Row, Col, Fg, Bg)
  6. DECLARE SUB SetBackIntens (Board, Setting)
  7.  
  8. DIM SHARED Regs AS RegType
  9.  
  10. DIM Colors$(0 TO 15)
  11. FOR X = 0 TO 15
  12.   READ Colors$(X)
  13. NEXT
  14. DATA Bright White, Yellow, Bright Purple, Bright Red, Bright Cyan
  15. DATA Bright Green, Bright Blue, Grey, White, Brown, Purple, Red
  16. DATA Cyan, Green, Blue, Black
  17.  
  18. MDAHerc = 0
  19. CGA = 1
  20. EgaVga = 2
  21.  
  22. BlinkOn = 0
  23. BlinkOff = 1
  24.  
  25. CLS
  26. CALL SetBackIntens(EgaVga, BlinkOff)
  27.  
  28. Title$ = "High intensity background colors in QuickBASIC 4.5"
  29. FPrint Title$, 4, 40 - LEN(Title$) \ 2 + 1, 15, 0
  30.  
  31. FOR Row = 1 TO 15
  32.  
  33.   FOR PlaceBar = 0 TO 15
  34.  
  35.     StartPos = ABS(Row - 2) + 1
  36.     Item$ = Colors$(15 - PlaceBar)
  37.  
  38.     IF Row < 2 OR Row > LEN(Item$) + 1 THEN
  39.       Text$ = "     "
  40.     ELSE
  41.       Text$ = "  " + MID$(Item$, StartPos, 1) + "  "
  42.     END IF
  43.  
  44.     IF PlaceBar > 7 THEN Switch = 1
  45.  
  46.     IF Switch = 1 THEN
  47.       Fg = 31 - PlaceBar
  48.     ELSE
  49.       Fg = 15 - PlaceBar
  50.     END IF
  51.  
  52.     Bg = PlaceBar
  53.     FPrint Text$, Row + 6, 1 + PlaceBar * 5, Fg, Bg
  54.  
  55.   NEXT
  56.  
  57.   Switch = 0
  58.  
  59. NEXT
  60.  
  61. COLOR 7, 0                              'restore the default colors
  62. WHILE LEN(INKEY$) = 0: WEND             'wait for a keypress
  63.  
  64. CALL SetBackIntens(EgaVga, BlinkOn)     'then restore normal flashing
  65.  
  66. SUB FPrint (Text$, Row, Col, Fg, Bg) STATIC
  67.  
  68.   LOCATE Row, Col
  69.   COLOR Fg, Bg
  70.   PRINT Text$;
  71.  
  72. END SUB
  73.  
  74. SUB SetBackIntens (Board, Setting) STATIC
  75.  
  76.   CONST MDAHerc = &H3B8                'the MDA/Hercules port address
  77.   CONST CGA = &H3D8                    'the CGA port address
  78.  
  79.   IF Setting THEN                      'exchange blinking for high-intensity
  80.     SELECT CASE Board
  81.       CASE 0                           'monochrome adapter
  82.     OUT MDAHerc, 9
  83.       CASE 1                           'CGA adapter
  84.     OUT CGA, 9
  85.       CASE 2                           'EGA/VGA adapter
  86.     Regs.AX = &H1003
  87.     Regs.BX = 0
  88.     CALL Interrupt(&H10, Regs, Regs)
  89.     END SELECT
  90.  
  91.   ELSE                                 'restore blinking (normal setting)
  92.  
  93.     SELECT CASE Board
  94.       CASE 0
  95.     OUT MDAHerc, &H29
  96.       CASE 1
  97.     OUT CGA, &H29
  98.       CASE 2
  99.     Regs.AX = &H1003
  100.     Regs.BX = 1
  101.     CALL Interrupt(&H10, Regs, Regs)
  102.     END SELECT
  103.   END IF
  104.  
  105. END SUB
  106.