home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / MEMCOLOR.PRG < prev    next >
Text File  |  1991-12-13  |  4KB  |  126 lines
  1. *----------------------------------------------------------------------------
  2. *
  3. *   Program Name: MEMCOLOR.PRG      Copyright: EDON Corporation
  4. *   Date Created: 02/24/91           Language: Clipper S'87
  5. *   Time Created: 10:08:59             Author: Ed Phillips
  6. *    Description: Based on Greg Lief's Colors.prg from Compass for Clipper S'87
  7. *                 Selects color from a color table.
  8. *----------------------------------------------------------------------------
  9.  
  10.  
  11. PARAM curr_color
  12. PRIVATE oldrow, oldcol, oldcolor, mrow, mcol, palettetop, winbuff
  13. PRIVATE colorstrng, mfore, mback, keypress
  14.  
  15. palettetop = 7                                  && top row for palette - change this to suit your needs
  16.  
  17. ** save environment
  18. oldrow = ROW()
  19. oldcol = COL()
  20. oldcolor = SETCOLOR()
  21. winbuff = SAVESCREEN(palettetop, 16, palettetop + 8, 63)
  22.  
  23. ** this string will be used in converting color numbers in the
  24. ** range of 0-127 to dBASE color strings (e.g. "W/N" etc)
  25. colorstrng = 'N  B  G  BG R  BR GR W  N+ B+ G+ BG+R+ BR+GR+W+ '
  26.  
  27. ** set start-up color to current color if no parameter passed
  28. curr_color = IF(PCOUNT() = 0, SETCOLOR(), UPPER(curr_color))
  29.  
  30.  
  31. ******* parse this string to determine foreground and background colors
  32. *
  33. ** first determine how many characters are in the foreground color
  34. ** by locating the first slash in the string
  35. mslash = AT('/', curr_color)
  36. *
  37. ** background color will lie between the slash and the first comma,
  38. mcomma = AT(',', curr_color)
  39. ** but we also must allow for color parameters passed without a comma
  40. mcomma = IF(mcomma = 0, LEN(curr_color) + 1, mcomma)
  41. *
  42. ** break out the foreground and background colors
  43. mfore = SUBSTR(curr_color, 1, mslash - 1)
  44. mback = SUBSTR(curr_color, mslash + 1, mcomma - mslash - 1)
  45. *
  46. ** convert the string to a number
  47. curr_color = INT(AT(mfore, colorstrng)/3) + INT(AT(mback, colorstrng)/3)*16
  48. *
  49. ********
  50.  
  51. ** draw the color palette
  52. IF TYPE('palette') = 'C'
  53.    RESTSCREEN(palettetop, 16, palettetop + 8, 63, palette)
  54. ELSE
  55.    FOR mcol = 0 TO 15
  56.       FOR mrow = 0 TO 7
  57.          colorno = mrow*16 + mcol
  58.          SETCOLOR(color_n2s(colorno))
  59.          @ palettetop + mrow, 16 + mcol*3 SAY CHR(32)+CHR(4)+CHR(32)
  60.       NEXT
  61.    NEXT
  62.  
  63.    SETCOLOR('GR+/N')
  64.    @ palettetop + 8,16 CLEAR TO palettetop + 8,63
  65.    @ palettetop + 8,16 SAY CHR(24)+CHR(25)+CHR(27)+CHR(26)+' to move'
  66.    @ palettetop + 8,33 SAY 'Enter to select'
  67.    @ palettetop + 8,53 SAY 'Esc to exit'
  68.  
  69.    palette=SAVESCREEN(palettetop, 16, palettetop + 8, 63)
  70.    SAVE TO Scrnpal ALL LIKE palette
  71. ENDIF
  72.  
  73. ** determine starting row and column within palette
  74. mrow = palettetop + INT(curr_color/16)
  75. mcol = 17 + curr_color % 16 * 3
  76.  
  77. ** commence main keypress loop
  78. DO WHILE .T.
  79.  
  80.    ** draw blinking diamond to mark current color and get keypress
  81.    SETCOLOR('*' + color_n2s(curr_color))
  82.    @ mrow,mcol SAY CHR(4)
  83.    INKEY(0)
  84.    keypress = LASTKEY()
  85.  
  86.    ** clear blinking diamond
  87.    SETCOLOR(color_n2s(curr_color))
  88.    @ mrow,mcol SAY CHR(4)
  89.  
  90.    ** process keystroke
  91.    DO CASE
  92.          ** user pressed an arrow key (24=down, 5=up, 4=left, 19=right)
  93.       CASE (keypress = 24 .AND. mrow < palettetop+7) .OR. ;
  94.          (keypress = 5  .AND. mrow > palettetop) .OR.  ;
  95.          (keypress = 4  .AND. mcol < 62) .OR. ;
  96.          (keypress = 19 .AND. mcol > 17)
  97.          ** adjust row position for up or down arrows
  98.          mrow = mrow + IF(keypress = 24, 1, IF(keypress = 5, -1, 0))
  99.          ** adjust column position for left or right arrows
  100.          mcol = mcol + IF(keypress = 4, 3, IF(keypress = 19, -3, 0))
  101.          ** change color number accordingly
  102.          curr_color = curr_color + IF(keypress=24, 16, ;
  103.          IF(keypress = 5, -16, IF(keypress = 4, 1, -1)))
  104.          ** user pressed Enter or Esc - time to move along
  105.       CASE keypress = 13 .OR. keypress = 27
  106.          EXIT
  107.          ** user pressed something else
  108.       OTHERWISE
  109.          Alert()
  110.    ENDCASE
  111. ENDDO
  112.  
  113. ** restore environment
  114. @ oldrow, oldcol SAY ''
  115. IF Lastkey() != 27
  116.    Setcolor(Color_n2s(curr_color))
  117. ELSE
  118.    Setcolor(oldcolor)
  119. ENDIF                                            && IF Lastkey() != 27
  120.  
  121. RESTSCREEN(palettetop, 16, palettetop + 8, 63, winbuff)
  122.  
  123. RETURN
  124. * EOF: Memcolor.prg
  125.  
  126.