home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS - Coast to Coast
/
simteldosarchivecoasttocoast.iso
/
pcmag
/
vol12n07.zip
/
HICOLO.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-03-12
|
2KB
|
106 lines
DEFINT A-Z
'$INCLUDE: 'QB.BI'
DECLARE SUB FPrint (Text$, Row, Col, Fg, Bg)
DECLARE SUB SetBackIntens (Board, Setting)
DIM SHARED Regs AS RegType
DIM Colors$(0 TO 15)
FOR X = 0 TO 15
READ Colors$(X)
NEXT
DATA Bright White, Yellow, Bright Purple, Bright Red, Bright Cyan
DATA Bright Green, Bright Blue, Grey, White, Brown, Purple, Red
DATA Cyan, Green, Blue, Black
MDAHerc = 0
CGA = 1
EgaVga = 2
BlinkOn = 0
BlinkOff = 1
CLS
CALL SetBackIntens(EgaVga, BlinkOff)
Title$ = "High intensity background colors in QuickBASIC 4.5"
FPrint Title$, 4, 40 - LEN(Title$) \ 2 + 1, 15, 0
FOR Row = 1 TO 15
FOR PlaceBar = 0 TO 15
StartPos = ABS(Row - 2) + 1
Item$ = Colors$(15 - PlaceBar)
IF Row < 2 OR Row > LEN(Item$) + 1 THEN
Text$ = " "
ELSE
Text$ = " " + MID$(Item$, StartPos, 1) + " "
END IF
IF PlaceBar > 7 THEN Switch = 1
IF Switch = 1 THEN
Fg = 31 - PlaceBar
ELSE
Fg = 15 - PlaceBar
END IF
Bg = PlaceBar
FPrint Text$, Row + 6, 1 + PlaceBar * 5, Fg, Bg
NEXT
Switch = 0
NEXT
COLOR 7, 0 'restore the default colors
WHILE LEN(INKEY$) = 0: WEND 'wait for a keypress
CALL SetBackIntens(EgaVga, BlinkOn) 'then restore normal flashing
SUB FPrint (Text$, Row, Col, Fg, Bg) STATIC
LOCATE Row, Col
COLOR Fg, Bg
PRINT Text$;
END SUB
SUB SetBackIntens (Board, Setting) STATIC
CONST MDAHerc = &H3B8 'the MDA/Hercules port address
CONST CGA = &H3D8 'the CGA port address
IF Setting THEN 'exchange blinking for high-intensity
SELECT CASE Board
CASE 0 'monochrome adapter
OUT MDAHerc, 9
CASE 1 'CGA adapter
OUT CGA, 9
CASE 2 'EGA/VGA adapter
Regs.AX = &H1003
Regs.BX = 0
CALL Interrupt(&H10, Regs, Regs)
END SELECT
ELSE 'restore blinking (normal setting)
SELECT CASE Board
CASE 0
OUT MDAHerc, &H29
CASE 1
OUT CGA, &H29
CASE 2
Regs.AX = &H1003
Regs.BX = 1
CALL Interrupt(&H10, Regs, Regs)
END SELECT
END IF
END SUB