home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / homonlib.zip / COLORSET.BAS < prev    next >
BASIC Source File  |  1995-04-13  |  7KB  |  192 lines
  1. DEFINT A-Z
  2.  
  3. ' $INCLUDE: 'PARM.INC'
  4. ' $INCLUDE: 'SETCURS.INC'
  5. ' $INCLUDE: 'TRUEFALS.INC'
  6.  
  7. DECLARE FUNCTION ColorSet (hdr1$, hdr2$, parm(), defaults())
  8.  
  9. 'External procedures:
  10.  
  11. DECLARE SUB Box (t, l, b, r, boxtype$)
  12. DECLARE SUB Center (row, text$)
  13. DECLARE FUNCTION GetKey$ (parm())
  14. DECLARE SUB SetView (top, bot, parm())
  15. DECLARE FUNCTION VPage (p)
  16. DECLARE SUB Wipe (row)
  17. DECLARE SUB WipeArea (t, l, b, r)
  18.  
  19. FUNCTION ColorSet (hdr1$, hdr2$, parm(), defaults())
  20. '****************************************************************************
  21. 'A handy function to let the user set their color preferences.
  22. '
  23. 'The hdr1$ and hdr2$ arugments are text strings that will be centered on the
  24. ' first two lines of the screen.
  25. '
  26. 'The parm() array will be directly modified by ColorSet().  The function will
  27. ' return TRUE if any of the colors were changed, FALSE if they are the same
  28. ' as when the function was entered.  This is useful if the calling program
  29. ' needs to know whether to save the new values in some sort of a setup file
  30. ' or not.
  31. '
  32. 'The defaults() array should mimic the parm() array.  It must have subscripts
  33. ' ranging from MINCOLOR to MAXCOLOR at least.
  34. '
  35. 'Because this function changes colors and has to mess with the screen a bit,
  36. ' it does not restore the previous screen or viewport upon exiting.  The
  37. ' procedure that calls this function must know to repaint the screen and
  38. ' restore any active viewport upon returning.
  39. '
  40. '****************************************************************************
  41.  
  42. REDIM orig(MINCOLOR TO MAXCOLOR)             'Copy the current values for a
  43. FOR x = MINCOLOR TO MAXCOLOR                 'restore to previous request.
  44.      orig(x) = parm(x)
  45. NEXT x
  46.  
  47. REDIM lbl$(MINCOLOR TO MAXCOLOR)             'Define the text labels:
  48. lbl$(FGN) = "Normal foreground.... "
  49. lbl$(BGN) = "Normal background.... "
  50. lbl$(FGH) = "Highlighted fg....... "
  51. lbl$(FGD) = "Dimmed fg............ "
  52. lbl$(FGS) = "Selected fg.......... "
  53. lbl$(BGS) = "Selected bg.......... "
  54. lbl$(FGDS) = "Dimmed Selected fg... "
  55. lbl$(FGWB) = "Window Border fg..... "
  56. lbl$(BGWB) = "Window Border bg..... "
  57. lbl$(FGWT) = "Window Text fg....... "
  58. lbl$(BGWT) = "Window Text bg....... "
  59. lbl$(FGWS) = "Window Selected fg... "
  60. lbl$(BGWS) = "Window Selected bg... "
  61.  
  62. REDIM bgmax(MINCOLOR TO MAXCOLOR)            'Limit the color values to 0-15
  63. FOR x = MINCOLOR TO MAXCOLOR                 'for foregrounds and 0-7 for
  64.      bgmax(x) = 15                           'backgrounds.
  65. NEXT x
  66. bgmax(BGN) = 7
  67. bgmax(BGS) = 7
  68. bgmax(BGWB) = 7
  69. bgmax(BGWS) = 7
  70. bgmax(BGWT) = 7
  71.  
  72. workpage = VPage(0)                          'Allocate a video page
  73. oldcursor = SetCursor(SCNONE)                'Turn the cursor off
  74.  
  75. COLOR 7, 0                                   'Get a clean, black screen.
  76. VIEW PRINT: CLS
  77.  
  78. Center 1, hdr1$                              'Print the text that doesn't
  79. Center 2, hdr2$                              'ever change:
  80. LOCATE 3, 1
  81. PRINT STRING$(80, 205)
  82. VIEW PRINT 4 TO 24
  83. LOCATE 5, 22: PRINT "Set:   Prev:  Default:"
  84. FOR x = MINCOLOR TO MAXCOLOR
  85.      PRINT lbl$(x); TAB(30);
  86.      PRINT USING "##       ##"; orig(x); defaults(x)
  87. NEXT x
  88. Box 4, 45, 22, 80, "1"
  89. Wipe 24
  90. PRINT CHR$(24); CHR$(25); " = Select field    ";
  91. PRINT "l/r = Change value    P)revious    D)efault    ESC = Done";
  92.  
  93. refresh = TRUE                               'Set up for the main loop.
  94. sel = MINCOLOR
  95.  
  96. DO
  97.  
  98.      IF refresh THEN                         'Update the color examples only
  99.           SCREEN , , workpage, 0             'when they get changed.
  100.           PCOPY 0, workpage
  101.           COLOR parm(FGN), parm(BGN)
  102.           WipeArea 5, 46, 21, 79
  103.           LOCATE 6, 51: PRINT "      Normal Text       "
  104.           COLOR parm(FGH)
  105.           LOCATE 8, 51: PRINT "    Highlighted Text    "
  106.           COLOR parm(FGD)
  107.           LOCATE 10, 51: PRINT "      Dimmed Text       "
  108.           COLOR parm(FGS), parm(BGS)
  109.           LOCATE 12, 51: PRINT "  Normal Selected Text  "
  110.           COLOR parm(FGDS)
  111.           LOCATE 14, 51: PRINT "  Dimmed Selected Text  "
  112.           COLOR parm(FGWB), parm(BGWB)
  113.           Box 16, 50, 19, 75, ""
  114.           COLOR 0, 0
  115.           FOR x = 17 TO 19
  116.                LOCATE x, 76
  117.                PRINT " "
  118.           NEXT x
  119.           LOCATE 20, 51
  120.           PRINT SPACE$(26)
  121.           COLOR parm(FGWT), parm(BGWT)
  122.           LOCATE 17, 51: PRINT "       Window Text      "
  123.           LOCATE 18, 51: PRINT "                        "
  124.           COLOR parm(FGWS), parm(BGWS)
  125.           LOCATE 18, 54: PRINT " Window Selection "
  126.           PCOPY workpage, 0
  127.           SCREEN , , 0, 0
  128.           COLOR 7, 0
  129.           refresh = FALSE
  130.      END IF
  131.  
  132.      row = 6                                 'Show the current parm() values.
  133.      FOR x = MINCOLOR TO MAXCOLOR
  134.           LOCATE row, 23
  135.           IF x = sel THEN COLOR 0, 7
  136.           PRINT USING "##"; parm(x)
  137.           COLOR 7, 0
  138.           row = row + 1
  139.      NEXT x
  140.                                              'Get keyboard input:
  141.      SELECT CASE UCASE$(GetKey$(parm()))
  142.           CASE CHR$(27)                           'ESC
  143.                EXIT DO
  144.           CASE CHR$(0) + CHR$(72)                 'Up arrow
  145.                sel = sel - 1
  146.           CASE CHR$(0) + CHR$(80)                 'Down arrow
  147.                sel = sel + 1
  148.           CASE CHR$(0) + CHR$(75)                 'Left arrow (-)
  149.                parm(sel) = parm(sel) - 1
  150.                refresh = TRUE
  151.           CASE CHR$(0) + CHR$(77)                 'Right arrow (+)
  152.                parm(sel) = parm(sel) + 1
  153.                refresh = TRUE
  154.           CASE "P"                                'Previous
  155.                FOR x = MINCOLOR TO MAXCOLOR
  156.                     parm(x) = orig(x)
  157.                NEXT x
  158.                refresh = TRUE
  159.           CASE "D"                                'Default
  160.                FOR x = MINCOLOR TO MAXCOLOR
  161.                     parm(x) = defaults(x)
  162.                NEXT x
  163.                refresh = TRUE
  164.           CASE ELSE
  165.                'Do nothing
  166.      END SELECT
  167.  
  168.      IF sel < MINCOLOR THEN sel = MAXCOLOR
  169.      IF sel > MAXCOLOR THEN sel = MINCOLOR
  170.      IF parm(sel) < 0 THEN parm(sel) = bgmax(sel)
  171.      IF parm(sel) > bgmax(sel) THEN parm(sel) = 0
  172.  
  173. LOOP
  174.  
  175. FOR x = MINCOLOR TO MAXCOLOR            'See if anything changed.
  176.      IF parm(x) <> orig(x) THEN
  177.           ColorSet = TRUE
  178.           EXIT FOR
  179.      END IF
  180. NEXT x
  181.  
  182. ERASE orig                              'Release the temporary arrays.
  183. ERASE lbl$
  184. ERASE bgmax
  185.  
  186. x = VPage(workpage)                     'Release the video page.
  187. x = SetCursor(oldcursor)                'Restore the previous cursor value.
  188. COLOR parm(FGN), parm(BGN)              'Set the colors to normal.
  189.  
  190. END FUNCTION
  191.  
  192.