Code:
DEFINT A-Z'$INCLUDE: 'c:\dosemu\qb45\QB.BI'DECLARE SUB FPrint (Text$, Row, Col, Fg, Bg) ' Simple Print routineDECLARE SUB SetBackIntens (Board, Setting) ' Main routine to change the ' blinking/intensity bit ' on Herc/CGA/EGA/VGA boardsDIM SHARED Regs AS RegType ' Required by CALL InterruptDIM Colors$(0 TO 15) ' Used for DATA and color chg ' '=-=-= Data for Color names 'DATA Bright White, Yellow, Bright Purple, Bright Red, Bright CyanDATA Bright Green, Bright Blue, Grey, White, Brown, Purple, RedDATA Cyan, Green, Blue, BlackFOR X = 0 TO 15 ' Read the Color names in READ Colors$(X)NEXTMDAHerc = 0: CGA = 1: EgaVga = 2 ' Explicit variablesBlinkOn = 0: BlinkOff = 1Title$ = "High intensity background colors in QuickBASIC 4.5"CLS ' Clear the screen and setupCALL SetBackIntens(EgaVga, BlinkOff) ' the initial blinking state ' ' Display our title 'FPrint Title$, 4, 40 - LEN(Title$) \ 2 + 1, 15, 0 ' ' Now drop down the color ' bars with opposing ' foreground/backgroundFOR Row = 1 TO 15 FOR PlaceBar = 0 TO 15 StartPos = ABS(Row - 2) + 1 Item$ = Colors$(15 - PlaceBar) IF Row <2> 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 = 0NEXTCOLOR 7, 0 ' Normal Fg/Bg colors againWHILE LEN(INKEY$) = 0: WEND ' Wait for a keypressCALL SetBackIntens(EgaVga, BlinkOn) ' Then restore the display ' boards blink state settingSUB FPrint (Text$, Row, Col, Fg, Bg) STATIC LOCATE Row, Col COLOR Fg, Bg PRINT Text$;END SUBSUB 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 IfEND SUB
Statistics: Posted by RickWesh — Sat May 29, 2010 9:29 pm