home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBSCR20.ZIP / XCOLORS.BAS < prev   
Encoding:
BASIC Source File  |  1992-07-08  |  18.3 KB  |  397 lines
  1. '┌────────────────────────────────────────────────────────────────────────┐
  2. '│                                                                        │
  3. '│                          X C O L O R S . B A S                         │
  4. '│                                                                        │
  5. '│                   Supplementary Source Code for the                    │
  6. '│       The QBSCR Screen Routines for QuickBASIC 4.0+ Programmers        │
  7. '│                              Version 2.0                               │
  8. '│                                                                        │
  9. '│                   (C) Copyright 1992 by Tony Martin                    │
  10. '│                                                                        │
  11. '├────────────────────────────────────────────────────────────────────────┤
  12. '│                                                                        │
  13. '│  This source code is copyright 1992 by Tony Martin.  You may change    │
  14. '│  it to suit your programming needs, but you may not distribute any     │
  15. '│  modified copies of the library itself.  I retain all rights to the    │
  16. '│  source code and all library modules included with the QBSCR package,  │
  17. '│  as well as to the example programs.  You may not remove this notice   │
  18. '│  from any copies of the library itself you distribute.                 │
  19. '│                                                                        │
  20. '│  You are granted the right to use this source code for your own pro-   │
  21. '│  grams, without royalty payments or credits to me (though, if you      │
  22. '│  feel so inclined to give me credit, feel free to do so).  You MUST    │
  23. '│  register this software if you release a shareware or commercial       │
  24. '│  program that uses it.  You may use these routines in any type of      │
  25. '│  software you create, as long as it is not a programming toolbox or    │
  26. '│  package of routines OF ANY KIND.                                      │
  27. '│                                                                        │
  28. '│  This package is shareware.  If you find it useful or use it in any    │
  29. '│  software you release, you are requested to send a registration fee of │
  30. '│  $25.00 (U.S. funds only) to:                                          │
  31. '│                                                                        │
  32. '│                            Tony Martin                                 │
  33. '│                       1611 Harvest Green Ct.                           │
  34. '│                          Reston, VA 22094                              │
  35. '│                                                                        │
  36. '│  All registered users receive an 'official' disk set containing the    │
  37. '│  latest verison of the QBSCR routines.  For more information, see      │
  38. '│  the QBSCR documentation.                                              │
  39. '│                                                                        │
  40. '├────────────────────────────────────────────────────────────────────────┤
  41. '│                                                                        │
  42. '│  For information on using these routines and incorporating them into   │
  43. '│  your own programs, see the accompanying documentation.                │
  44. '│                                                                        │
  45. '└────────────────────────────────────────────────────────────────────────┘
  46.  
  47. ' ──────────────────────────────────────────────────────────────────────────
  48. ' Include QB.BI to get access to the RegType type and the Interrupt sub.
  49. ' ──────────────────────────────────────────────────────────────────────────
  50. REM $INCLUDE: 'qb.bi'
  51.  
  52. ' ──────────────────────────────────────────────────────────────────────────
  53. ' The three simple declare statements for this library...
  54. ' ──────────────────────────────────────────────────────────────────────────
  55. DECLARE FUNCTION EgaPresent% ()
  56. DECLARE FUNCTION rgbRGB% (red%, green%, blue%)
  57. DECLARE FUNCTION VgaPresent% ()
  58. DECLARE SUB BlinkOff ()
  59. DECLARE SUB BlinkOn ()
  60. DECLARE SUB LoadVgaTextFont (fontfile$)
  61. DECLARE SUB LoadEgaTextFont (fontfile$)
  62.  
  63. ' ──────────────────────────────────────────────────────────────────────────
  64. ' Required constants.
  65. ' ──────────────────────────────────────────────────────────────────────────
  66. CONST FALSE = 0, TRUE = NOT FALSE
  67.  
  68. COMMON SHARED mouseExists%, mouseState%
  69.  
  70. SUB BlinkOff
  71.  
  72.     ' ────────────────────────────────────────────────────────────────────────
  73.     ' This routine disables blinking characters and instead allows high-
  74.     ' intensity background colors.  To obtain a high-intensity background,
  75.     ' you must set your backgound color normally (to a value from 0 to 7),
  76.     ' and then add 16 to the foreground color, just as if you were making
  77.     ' a blinking foreground.  Example:
  78.     '
  79.     '   To set a Dark Blue foreground onto a high-intensity White background,
  80.     '   the following steps would be performed:
  81.     '
  82.     '     1. Call BlinkOff once.
  83.     '     2. Set your background color to White (7).
  84.     '     3. Set your foreground color to Dark Blue (1) plus 16 for the
  85.     '        bright background.
  86.     '     4. Issue a color statement with these values.
  87.     '     5. Display any text you desire in these colors.
  88.     ' ────────────────────────────────────────────────────────────────────────
  89.  
  90.  
  91.     ' ────────────────────────────────────────────────────────────────────────
  92.     ' We may need to make a BIOS call to set blink off (if EGA or VGA is
  93.     ' present), so DIMension an object of RegType, that represents the
  94.     ' CPU's registers, for use with the Interrupt routine.
  95.     ' ────────────────────────────────────────────────────────────────────────
  96.  
  97.     DIM reg AS RegType
  98.  
  99.  
  100.     ' ────────────────────────────────────────────────────────────────────────
  101.     ' Check to see if an EGA or VGA is present.  If so, call BIOS function
  102.     ' 1003h with register BX set to 0 (Blink OFF).  If EGA/VGA is NOT present
  103.     ' (CGA is there), then send hex value 09h to port 3D8h, to turn off the
  104.     ' blink attribute.
  105.     ' ────────────────────────────────────────────────────────────────────────
  106.  
  107.     IF EgaPresent% THEN
  108.         reg.ax = &H1003
  109.         reg.bx = 0
  110.         INTERRUPT &H10, reg, reg
  111.     ELSE
  112.         OUT &H3D8, 9
  113.     END IF
  114.  
  115. END SUB
  116.  
  117. SUB BlinkOn
  118.  
  119.     ' ────────────────────────────────────────────────────────────────────────
  120.     ' This routine enables blinking characters and turns off high-
  121.     ' intensity background colors.   Call this when you want to restore the
  122.     ' blinking attribute, such as right before your program ends.
  123.     ' ────────────────────────────────────────────────────────────────────────
  124.  
  125.  
  126.     ' ────────────────────────────────────────────────────────────────────────
  127.     ' We may need to make a BIOS call to set blink on (if EGA or VGA is
  128.     ' present), so DIMension an object of RegType, that represents the
  129.     ' CPU's registers, for use with the Interrupt routine.
  130.     ' ────────────────────────────────────────────────────────────────────────
  131.  
  132.     DIM reg AS RegType
  133.  
  134.  
  135.     ' ────────────────────────────────────────────────────────────────────────
  136.     ' Check to see if an EGA or VGA is present.  If so, call BIOS function
  137.     ' 1003h with register BX set to 1 (Blink ON).  If EGA/VGA is NOT present
  138.     ' (CGA is there), then send value 41 to port 3D8h, to turn on the
  139.     ' blink attribute.
  140.     ' ────────────────────────────────────────────────────────────────────────
  141.  
  142.     IF EgaPresent% THEN
  143.         reg.ax = &H1003
  144.         reg.bx = 1
  145.         INTERRUPT &H10, reg, reg
  146.     ELSE
  147.         OUT &H3D8, 41
  148.     END IF
  149.  
  150. END SUB
  151.  
  152. FUNCTION EgaPresent%
  153.  
  154.     ' ────────────────────────────────────────────────────────────────────────
  155.     ' This routine checks for the presence of an EGA or VGA graphics card.
  156.     ' If one is found, the function returns TRUE (non-zero).  If one is not
  157.     ' found, then the function returns FALSE (zero).  This function is only
  158.     ' used internally and does not need to be called directly by the
  159.     ' programmer.
  160.     ' ────────────────────────────────────────────────────────────────────────
  161.  
  162.     ' ────────────────────────────────────────────────────────────────────────
  163.     ' We will need to make a BIOS call to check for the EGA/VGA.  Therefore,
  164.     ' we must DIMension an object of RegType, that represents the
  165.     ' CPU's registers, for use with the Interrupt routine.
  166.     ' ────────────────────────────────────────────────────────────────────────
  167.     DIM ireg AS RegType
  168.     
  169.     ' ────────────────────────────────────────────────────────────────────────
  170.     ' Set the AH register (the high byte of AX) to hex 12h, and the BL
  171.     ' register (the low byte of BX) to hex 10h.  Then make the call to
  172.     ' Interrupt 10h.  This Interrupt is actually a call to the Alternate
  173.     ' Select routine, which, in this case, is returning to us some information
  174.     ' about the EGA card (if we were interested, such info as color or mono
  175.     ' mode, amount of video memory, and the EGA switch settings).  If an EGA
  176.     ' or VGA is present, the BX register will return some info and will have
  177.     ' a different value than the one we put in it (10h).  If there is no
  178.     ' EGA or VGA present, then BX will contain the same value we put in it
  179.     ' before the call to the Interrupt (10h).
  180.     ' ────────────────────────────────────────────────────────────────────────
  181.     ireg.ax = &H12 * 256
  182.     ireg.bx = &H10
  183.  
  184.     INTERRUPT &H10, ireg, ireg
  185.  
  186.     ' ────────────────────────────────────────────────────────────────────────
  187.     ' If BX has 10h in it, there is no EGA/VGA present.  If it has some other
  188.     ' value, then an EGA or VGA is present.
  189.     ' ────────────────────────────────────────────────────────────────────────
  190.     IF ireg.bx = &H10 THEN
  191.         EgaPresent% = FALSE
  192.     ELSE
  193.         EgaPresent% = TRUE
  194.     END IF
  195.  
  196. END FUNCTION
  197.  
  198. SUB LoadEgaTextFont (fontfile$)
  199.  
  200.     ' ────────────────────────────────────────────────────────────────────────
  201.     ' This SUB loads the data from a premade VGA font file and informs the
  202.     ' VGA card that it should load it.  It first checks to see if there is a
  203.     ' VGA card present.  If not, thius SUB exist without loading the font.
  204.     ' ────────────────────────────────────────────────────────────────────────
  205.  
  206.     ' ────────────────────────────────────────────────────────────────────────
  207.     ' Define some of the data required here.
  208.     ' ────────────────────────────────────────────────────────────────────────
  209.     DIM regx AS RegTypeX
  210.     DIM charData AS STRING * 3584
  211.  
  212.     ' ────────────────────────────────────────────────────────────────────────
  213.     ' If the fontfile name is "", then reset the font to normal EGA 8x14.
  214.     ' The EGA BIOS service is &H11 (in AH), font-related services.  The sub-
  215.     ' service, &H01 (in AL), is Load ROM 8x14 character set.  When done,
  216.     ' get outta here.
  217.     ' ────────────────────────────────────────────────────────────────────────
  218.     IF fontfile$ = "" THEN
  219.         regx.ax = &H1101             ' Load ROM 8x14 character set.
  220.         INTERRUPTX &H10, regx, regx
  221.         EXIT SUB
  222.     END IF
  223.  
  224.     ' ────────────────────────────────────────────────────────────────────────
  225.     ' Open font file and load font data.  Note that it is assumed that the
  226.     ' font file exists.  If it does not, then your screen will be blank,
  227.     ' since this function loaded all zeros.  Call this function with a font
  228.     ' file name of "" to restore screen font if this happens.
  229.     ' ────────────────────────────────────────────────────────────────────────
  230.     fontfile$ = LTRIM$(RTRIM$(fontfile$))
  231.     OPEN fontfile$ FOR RANDOM AS #99 LEN = 3584   ' 3584 bytes in font file.
  232.     GET #99, 1, charData
  233.     CLOSE #99
  234.     fontData$ = LEFT$(charData, 3584)    ' Make sure only 3854 bytes.
  235.  
  236.     ' ────────────────────────────────────────────────────────────────────────
  237.     ' Set up register values for call to VGA BIOS.
  238.     ' ────────────────────────────────────────────────────────────────────────
  239.     regx.bp = SADD(fontData$)       ' Offset of font data address.
  240.     regx.es = VARSEG(fontData$)     ' Segment of font data address.
  241.     regx.ax = &H1100                ' Service &H11, sub-service &H00.
  242.     regx.bx = &HE00                 ' 14 bytes/char, Load into block 0.
  243.     regx.cx = 256                   ' Load all 256 characters.
  244.     regx.dx = 0                     ' Start at offset 0 (into font data).
  245.  
  246.     ' ────────────────────────────────────────────────────────────────────────
  247.     ' Load that font!
  248.     ' ────────────────────────────────────────────────────────────────────────
  249.     INTERRUPTX &H10, regx, regx
  250.  
  251. END SUB
  252.  
  253. SUB LoadVgaTextFont (fontfile$)
  254.  
  255.     ' ────────────────────────────────────────────────────────────────────────
  256.     ' This SUB loads the data from a premade VGA font file and informs the
  257.     ' VGA card that it should load it.  It first checks to see if there is a
  258.     ' VGA card present.  If not, thius SUB exist without loading the font.
  259.     ' ────────────────────────────────────────────────────────────────────────
  260.  
  261.     ' ────────────────────────────────────────────────────────────────────────
  262.     ' Define some of the data required here.
  263.     ' ────────────────────────────────────────────────────────────────────────
  264.     DIM regx AS RegTypeX
  265.     DIM charData AS STRING * 4096
  266.  
  267.     ' ────────────────────────────────────────────────────────────────────────
  268.     ' If the fontfile name is "", then reset the font to normal VGA 8x16.
  269.     ' The VGA BIOS service is &H11 (in AH), font-related services.  The sub-
  270.     ' service, &H04 (in AL), is Load ROM 8x16 character set.  When done,
  271.     ' get outta here.
  272.     ' ────────────────────────────────────────────────────────────────────────
  273.     IF fontfile$ = "" THEN
  274.         regx.ax = &H1104
  275.         INTERRUPTX &H10, regx, regx
  276.         EXIT SUB
  277.     END IF
  278.  
  279.     ' ────────────────────────────────────────────────────────────────────────
  280.     ' Open font file and load font data.  Note that it is assumed that the
  281.     ' font file exists.  If it does not, then your screen will be blank,
  282.     ' since this function loaded all zeros.  Call this function with a font
  283.     ' file name of "" to restore screen font if this happens.
  284.     ' ────────────────────────────────────────────────────────────────────────
  285.     fontfile$ = LTRIM$(RTRIM$(fontfile$))
  286.     OPEN fontfile$ FOR RANDOM AS #99 LEN = 4096   ' 4096 bytes in font file.
  287.     GET #99, 1, charData
  288.     CLOSE #99
  289.     fontData$ = LEFT$(charData, 4096)     ' Make sure only 4096 bytes!
  290.  
  291.     ' ────────────────────────────────────────────────────────────────────────
  292.     ' Set up register values for call to VGA BIOS.
  293.     ' ────────────────────────────────────────────────────────────────────────
  294.     regx.bp = SADD(fontData$)       ' Offset of font data address.
  295.     regx.es = VARSEG(fontData$)     ' Segment of font data address.
  296.     regx.ax = &H1100                ' Service &H11, sub-service &H00.
  297.     regx.bx = &H1000                ' 4096 bytes in character data.
  298.     regx.cx = 256                   ' Load all 256 characters.
  299.     regx.dx = 0                     ' Start at offset 0 (into font data).
  300.  
  301.     ' ────────────────────────────────────────────────────────────────────────
  302.     ' Load that font!
  303.     ' ────────────────────────────────────────────────────────────────────────
  304.     INTERRUPTX &H10, regx, regx
  305.  
  306. END SUB
  307.  
  308. FUNCTION rgbRGB% (red%, green%, blue%)
  309.  
  310.     ' ────────────────────────────────────────────────────────────────────────
  311.     ' This function calculates an attribute color value for extended EGA/VGA
  312.     ' colors in text mode.  Pass in red, green and blue values from 0 to 3
  313.     ' each to form up to 64 (0-63) possible colors.
  314.     '
  315.     ' Red, green, and blue colors mix to form the following colors:
  316.     '
  317.     '             CYAN    = BLUE + GREEN
  318.     '             MAGENTA = BLUE + RED
  319.     '             YELLOW  = RED + GREEN
  320.     '             WHITE   = RED + GREEN + BLUE
  321.     '
  322.     ' For example, to get bright yellow, a call to rgbRGB would look like
  323.     ' this (in combination with the palette statement):
  324.     '
  325.     '             PALETTE 1, rgbRGB%( 3, 3, 0 )
  326.     '
  327.     ' Play around with this function -- you can mix all kinds of combinations
  328.     ' to get some really nifty colors.
  329.     '
  330.     ' ────────────────────────────────────────────────────────────────────────
  331.  
  332.     ' ────────────────────────────────────────────────────────────────────────
  333.     ' Ensure that each parameter passed in is in the range of 0-3.
  334.     ' ────────────────────────────────────────────────────────────────────────
  335.     red% = red% AND 3
  336.     green% = green% AND 3
  337.     blue% = blue% AND 3
  338.  
  339.     ' ────────────────────────────────────────────────────────────────────────
  340.     ' Calculate an EGA/VGA rgbRGB color value for the passed-in values.
  341.     ' ────────────────────────────────────────────────────────────────────────
  342.     clr% = 0
  343.  
  344.     clr% = clr% + ((red% AND 1) * 32)          ' Add lo red if red = 1 or 3
  345.     IF (red% AND 2) THEN clr% = clr% + 4       ' Add hi red if red = 2 or 3
  346.  
  347.     clr% = clr% + ((green% AND 1) * 16)        ' Add lo green if green = 1 or 3
  348.     IF (green% AND 2) THEN clr% = clr% + 2     ' Add hi green if green = 2 or 3
  349.  
  350.     clr% = clr% + ((blue% AND 1) * 8)          ' Add lo blue if blue = 1 or 3
  351.     IF (blue% AND 2) THEN clr% = clr% + 1      ' Add hi blue if blue = 2 or 3
  352.  
  353.     ' ────────────────────────────────────────────────────────────────────────
  354.     ' That's it!  Return our color value, ready for use in a QB PALETTE
  355.     ' statement.
  356.     ' ────────────────────────────────────────────────────────────────────────
  357.     rgbRGB% = clr%
  358.  
  359. END FUNCTION
  360.  
  361. FUNCTION VgaPresent%
  362.  
  363.     ' ────────────────────────────────────────────────────────────────────────
  364.     ' This function determines whether or not a VGA card is present in the
  365.     ' system.  If it is, this function returns TRUE (non-zero).  If there is
  366.     ' not a VGA card present, this function returns FALSE (zero).
  367.     ' ────────────────────────────────────────────────────────────────────────
  368.  
  369.     ' ────────────────────────────────────────────────────────────────────────
  370.     ' Set up data to be used.
  371.     ' ────────────────────────────────────────────────────────────────────────
  372.     DIM iregx AS RegTypeX
  373.     DIM oregx AS RegTypeX
  374.  
  375.     ' ────────────────────────────────────────────────────────────────────────
  376.     ' Set up register variables for interruptx call.  Service &H1A00 calls
  377.     ' the VGA Read or Write Display Combination Code BIOS routine. It will
  378.     ' return value &H1A in register AL (AX), if a VGA is there. Any other
  379.     ' value means the function call failed, hence, no VGA.  NOTE: We need
  380.     ' both INPUT (iregx) and OUTPUT (oregx) register variables here, since
  381.     ' they overlap.
  382.     ' ────────────────────────────────────────────────────────────────────────
  383.     iregx.ax = &H1A00
  384.     INTERRUPTX &H10, iregx, oregx
  385.  
  386.     ' ────────────────────────────────────────────────────────────────────────
  387.     ' Return value based on INTERRUPTX BIOS call return value.
  388.     ' ────────────────────────────────────────────────────────────────────────
  389.     IF (oregx.ax AND &HFF) = &H1A THEN
  390.         VgaPresent% = TRUE
  391.     ELSE
  392.         VgaPresent% = FALSE
  393.     END IF
  394.  
  395. END FUNCTION
  396.  
  397.