home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 101.img / QB45-1.ZIP / PALETTE.BAS < prev    next >
BASIC Source File  |  1988-09-12  |  2KB  |  63 lines
  1. DECLARE SUB InitPalette ()
  2. DECLARE SUB ChangePalette ()
  3. DECLARE SUB DrawEllipses ()
  4. DEFINT A-Z
  5.  
  6. DIM SHARED PaletteArray(15)
  7.  
  8. SCREEN 8                 ' 640 x 200 resolution; 16 colors
  9.  
  10. InitPalette
  11. DrawEllipses
  12.  
  13. DO
  14.    ChangePalette
  15. LOOP WHILE INKEY$ = ""   ' Shift palette until key pressed
  16.  
  17. END
  18.  
  19. '
  20. ' ======================= InitPalette ========================
  21. '    This procedure initializes the integer array used to
  22. '    change the palette.
  23. ' ============================================================
  24. '
  25. SUB InitPalette STATIC
  26.    FOR I = 0 TO 15
  27.       PaletteArray(I) = I
  28.    NEXT I
  29. END SUB
  30.  
  31. '
  32. ' ====================== DrawEllipses ========================
  33. '    This procedure draws fifteen concentric ellipses, and
  34. '    paints the interior of each with a different color.
  35. ' ============================================================
  36. '
  37. SUB DrawEllipses STATIC
  38.    CONST ASPECT = 1 / 3
  39.    FOR ColorVal = 15 TO 1 STEP -1
  40.       Radius = 20 * ColorVal
  41.       CIRCLE (320, 100), Radius, ColorVal, , , ASPECT
  42.       PAINT (320, 100), ColorVal
  43.    NEXT
  44. END SUB
  45.  
  46. '
  47. ' ====================== ChangePalette =======================
  48. '    This procedure rotates the palette by one each time it
  49. '    is called.  For example, after the first call to
  50. '    ChangePalette, PaletteArray(1) = 2, PaletteArray(2) = 3,
  51. '    . . . , PaletteArray(14) = 15, and PaletteArray(15) = 1
  52. ' ============================================================
  53. '
  54. SUB ChangePalette STATIC
  55.    FOR I = 1 TO 15
  56.       PaletteArray(I) = (PaletteArray(I) MOD 15) + 1
  57.    NEXT I
  58.  
  59.    ' Shift the color displayed by each of the attributes from
  60.    ' one to fifteen:
  61.    PALETTE USING PaletteArray(0)
  62. END SUB
  63.