home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 35.dms / 35.adf / rgbmenu.bas < prev    next >
BASIC Source File  |  1988-05-22  |  1KB  |  61 lines
  1. 1     REM RGBMENU.BAS by Henry Birdseye
  2. 5     dim a$(3)
  3. 6     a$(0)="red":a$(1)="grn":a$(2)="blu"
  4. 10    screen 0,5,0
  5. 20    for y%=0to 3
  6. 30    for x%=0to 7
  7. 40    col%=(x%*4)+y%
  8. 50    pena col%
  9. 60    xx%=x%*23:yy%=y%*23
  10. 70    box (xx%,yy%;xx%+23,yy%+23),1
  11. 80    next
  12. 90    next
  13. 100   graphic(1)
  14. 105   pena 1
  15. 110   widt%=180'ask window widt%,y%
  16. 120   bst%=100
  17. 130   for i%=0 to 2
  18. 140   'box(30,bst%+(i%*10);widt%,bst%+9+(i%*10))
  19. 145   print at(0,bst%+8+i%*10);a$(i%)
  20. 150   next
  21. 155   ii=(widt%-30)/16
  22. 160   for i%=0 to 16
  23. 170   x%=i%*ii + 30%
  24. 180   draw(x%,bst%-6 to x%,bst%)
  25. 190   next
  26. 1000  ask mouse wx%,wy%,b%
  27. 1010  if b%=0 then 1000
  28. 1015  if wx%>181 then goto 1000
  29. 1020  if wy%>92 then goto 2000
  30. 1025  p%=wx%:q%=wy%
  31. 1030  wx%=(wx%-9)/23
  32. 1040  wy%=(wy%-11)/23
  33. 1050  col%=wx%*4+wy%
  34. 1055  gosub 2040
  35. 1056  ask mouse x%,y%,b%
  36. 1057  if b%<>0 then goto 1056
  37. 1060  goto 1000
  38. 2000  if wy%<=bst% or wy%>130 then goto 1000
  39. 2005  ask mouse wx%,wy%,b%
  40. 2007  if b%=0 then goto 2005
  41. 2008  wx%=wx%-8
  42. 2009  if wx%<30 then goto 2000
  43. 2010  wy%=wy%-bst%-6
  44. 2015  which%=wy%/10
  45. 2016  if xy%<0 then wy%=0
  46. 2020  place = (wx%-30)/9.375
  47. 2030  color%=place
  48. 2031  hue%(which%)=color%
  49. 2032  rgb col%,hue%(0),hue%(1),hue%(2)
  50. 2033  gosub 2040
  51. 2034  ask mouse x%,y%,b%
  52. 2035  if b%<>0 then goto 2034
  53. 2036  goto 2000
  54. 2040  ask rgb col%,hue%(0),hue%(1),hue%(2)
  55. 2041  pena col%:box(31,bst%;widt%,bst%+30),1
  56. 2045  pena 1
  57. 2050  for i%=0 to 2
  58. 2060  box(31,bst%+2+(i%*10);39+(hue%(i%)*ii),bst%+9+(i%*10)),1
  59. 2070  next
  60. 2080  return
  61.