home *** CD-ROM | disk | FTP | other *** search
/ Software Du Jour / SoftwareDuJour.iso / BUSINESS / DBASE / NEWCOLOR.ARC / NEWCOLOR.PRG < prev    next >
Encoding:
Text File  |  1986-05-29  |  1.6 KB  |  65 lines
  1. * NEWCOLOR.PRG
  2. * AUTHOR: Steve Titterud
  3. *         Copyright 1986 all rights reserved
  4. * NOTES: A color selection module which uses procedure file NEWCOLOR.PRO.
  5. *        
  6. clea
  7. set talk off
  8. set echo off
  9. set scoreboard off
  10. set proc to newcolor.pro
  11. set colo to w+/n,n/w,n
  12. blinker= "w+*/n"
  13. normal= "w+/n"
  14. temp_nfg= "w+"
  15. temp_nbg= "n"
  16. temp_efg= "n"
  17. temp_ebg= "w"
  18. temp_brd= "w"
  19. colortxt="7 w  8 w+ 9 gr 10gr+11br 12br+13r  14r+ 15bg 16bg+17g  18g+ 19b  20b+ 21n  22n+ "
  20. firstinstr=.t.
  21. keygot=0
  22. colorrow=7
  23. arearow=12
  24. colorflag=.f.
  25. makelowvid=.f.
  26. noquit=.T.
  27. do screenup
  28. do instruct
  29. do whil keygot=0 .and. noquit
  30. keygot=inkey()
  31. do whil keygot#0
  32. @ colorrow,3 say "   "
  33. @ arearow,11 say "   "
  34. makelowvid=iif(arearow=13 .or. arearow=15 .or. arearow=16,.t.,.f.)
  35. colorrow=iif(makelowvid .and. mod(colorrow,2)=0,colorrow-1,colorrow) 
  36. do case
  37. case keygot=5 .and. colorflag
  38. colorrow=iif(makelowvid,iif(colorrow=7,21,colorrow-2),iif(colorrow=7,22,colorrow-1))
  39. case keygot=24 .and. colorflag
  40. colorrow=iif(makelowvid,iif(colorrow=21,7,colorrow+2),iif(colorrow=22,7,colorrow+1))
  41. case keygot=5 .and. .not. colorflag
  42. arearow=iif(arearow=12,16,arearow-1)
  43. case keygot=24 .and. .not. colorflag
  44. arearow=iif(arearow=16,12,arearow+1)
  45. case keygot=13 .and. .not. colorflag
  46. colorflag=.t.
  47. case keygot=13 .and. colorflag
  48. do temp_set
  49. do sampler
  50. set colo to &normal
  51. colorflag=.f.
  52. endc
  53. @ colorrow,3 say iif(colorflag, "══" , "   " )
  54. @ arearow,11 say "══"
  55. noquit=iif(keygot=113,.F.,.T.)
  56. keygot=0
  57. endd
  58. endd
  59. clos proc
  60. set colo to &temp_nfg/&temp_nbg,&temp_efg/&temp_ebg,&temp_brd
  61. set talk on
  62. set echo on
  63. clea
  64. retu
  65.