home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Programmer's Library 1.3 / Microsoft-Programers-Library-v1.3.iso / sampcode / msj / msjv4_2 / basic / getcolor.bas next >
Encoding:
BASIC Source File  |  1988-08-02  |  1.9 KB  |  51 lines
  1. '********** Colors.Bas - set of color functions
  2.  
  3. 'Copyright (c) 1988 Ethan Winer
  4.  
  5.  
  6. DEFINT A-Z
  7. DECLARE SUB GetColor (FG, BG)           'gets BASIC's current colors
  8. DECLARE SUB SplitColor (XColor, FG, BG) '.ASM - splits a color into FG and BG
  9. DECLARE FUNCTION OneColor% (FG, BG)     '.ASM - combines FG/BG into one color
  10.  
  11.  
  12. CLS
  13. INPUT "Enter a foreground color value (0 to 31): ", FG
  14. INPUT "Enter a background color value (0 to 7) : ", BG
  15. COLOR FG, BG
  16.  
  17. PRINT : PRINT "BASIC's current color settings are: ";
  18. GetColor FG, BG
  19. PRINT FG; "and"; BG
  20.  
  21. PRINT "That combines to the single byte value of"; OneColor%(FG, BG)
  22. PRINT "Broken back out results in";
  23. SplitColor OneColor%(FG, BG), NewFG, NewBG
  24. PRINT NewFG; "and"; NewBG
  25.  
  26. COLOR 7, 0      'restore defaults before ending
  27.  
  28. 'This function obtains BASIC's current colors by first saving the
  29. 'character and color in the upper left corner of the screen.  Next,
  30. 'a blank space is printed there, and SCREEN is used to see what color
  31. 'was used.  Finally, the original screen contents are restored.
  32. '
  33. SUB GetColor (FG%, BG%) STATIC
  34.     V% = CSRLIN                         'save the current cursor location
  35.     H% = POS(0)
  36.     SaveChar% = SCREEN(1, 1)            'save the current character
  37.     SaveColor% = SCREEN(1, 1, 1)        'and its color
  38.     SplitColor SaveColor%, SaveFG%, SaveBG%
  39.  
  40.     LOCATE 1, 1                         'print with BASIC's current color
  41.     PRINT " "; CHR$(29);                'back up the cursor to 1,1
  42.     CurColor% = SCREEN(1, 1, 1)         'read the current color
  43.     COLOR SaveFG%, SaveBG%              'restore the original color at 1,1
  44.     PRINT CHR$(SaveChar%);              'and the character
  45.  
  46.     LOCATE V%, H%                       'put the cursor back where it was
  47.     SplitColor CurColor%, FG%, BG%      'split the color into separate FG & BG
  48.     COLOR FG%, BG%                      'restore BASIC's current value for it
  49. END SUB
  50.  
  51.