home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Programmer's Library 1.3 / Microsoft-Programers-Library-v1.3.iso / sampcode / basic / palette.bas < prev    next >
Encoding:
BASIC Source File  |  1989-11-09  |  1.7 KB  |  60 lines
  1. DECLARE SUB InitPalette ()
  2. DECLARE    SUB ChangePalette ()
  3. DECLARE    SUB DrawEllipses ()
  4.  
  5. DEFINT A-Z
  6. DIM SHARED PaletteArray(15)
  7.  
  8. SCREEN 8         ' 640 x 200 resolution; 16 colors
  9.  
  10. InitPalette         ' Initialize PaletteArray.
  11. DrawEllipses         ' Draw and paint concentric ellipses.
  12.  
  13. DO             ' Shift the palette until a key
  14.    ChangePalette     ' is pressed.
  15. LOOP WHILE INKEY$ = ""
  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. ' ===================== DrawEllipses ======================
  31. '    This procedure draws 15 concentric ellipses and
  32. '    paints the interior of each with a different color.
  33. ' =========================================================
  34.  
  35. SUB DrawEllipses STATIC
  36.    CONST ASPECT    = 1 / 3
  37.    FOR ColorVal    = 15 TO    1 STEP -1
  38.       Radius = 20 * ColorVal
  39.       CIRCLE (320, 100), Radius, ColorVal, , , ASPECT
  40.       PAINT (320, 100),    ColorVal
  41.    NEXT
  42. END SUB
  43.  
  44.  
  45. ' ===================== ChangePalette =====================
  46. '  This procedure rotates the palette by one each time it
  47. '  is called. For example, after the first call to
  48. '  ChangePalette, PaletteArray(1) = 2, PaletteArray(2) = 3,
  49. '  . . . , PaletteArray(14) = 15, and PaletteArray(15) = 1
  50. ' =========================================================
  51.  
  52. SUB ChangePalette STATIC
  53.    FOR I = 1 TO    15
  54.       PaletteArray(I) =    (PaletteArray(I) MOD 15) + 1
  55.    NEXT    I
  56.    PALETTE USING PaletteArray(0) ' Shift the color displayed
  57.                  ' by each of the attributes.
  58. END SUB
  59.  
  60.