home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / shimweel.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-20  |  2.3 KB  |  121 lines
  1. {
  2.  ******************************************************************************
  3.  * SHIMWEEL - Circle and palette demo.                          *
  4.  *                                          *
  5.  * Written for GRAFIX by:  Joseph A. Albrecht                      *
  6.  *                                          *
  7.  * Press F1 to restart program                              *
  8.  * Press F10 to toggle between 320 and 640 graphic modes              *
  9.  * Press ESC to exit program                              *
  10.  ******************************************************************************
  11. }
  12.  
  13. PROGRAM ShimmerWheel;
  14.  
  15. USES
  16.   Crt,
  17.   Grafix;
  18.  
  19. VAR
  20.   A, C, D, I, Graphics: INTEGER;
  21.   X, Y: WORD;
  22.   EndProgram, Loop, Tandy11: BOOLEAN;
  23.   Ch: CHAR;
  24.  
  25. PROCEDURE CheckKey;
  26.  
  27. VAR
  28.   Ch: CHAR;
  29.  
  30. BEGIN
  31.  
  32.   Ch := #255;
  33.   IF KeyPressed THEN
  34.     Ch := ReadKey;
  35.   IF Ch = #27 THEN
  36.     BEGIN
  37.       Loop := False;
  38.       EndProgram := True;
  39.     END;
  40.   IF Ch = #00 THEN
  41.     BEGIN
  42.       Ch := ReadKey;
  43.       IF Ch = #59 THEN
  44.     Loop := False;
  45.       IF (Ch = #68) AND (Tandy11 = True) THEN
  46.     BEGIN
  47.       IF Graphics = 320 THEN
  48.         BEGIN
  49.           Graphics := 640;
  50.           A := 220;
  51.           Loop := False;
  52.           HighGraphics;
  53.         END
  54.       ELSE
  55.         BEGIN
  56.           Graphics := 320;
  57.           A := 110;
  58.           Loop := False;
  59.           MediumGraphics;
  60.         END;
  61.     END;
  62.     END;
  63.  
  64. END;
  65.  
  66. {Mainline}
  67. BEGIN
  68.  
  69.   Graphics := 320;
  70.   A := 110;
  71.   EndProgram := False;
  72.   Loop := True;
  73.   GetTandy11(Tandy11);
  74.   MediumGraphics;
  75.  
  76.   WHILE EndProgram = False DO
  77.     BEGIN
  78.       Randomize;
  79.       ClearScreen;
  80.       I := A;
  81.       WHILE I >= 50 DO
  82.     BEGIN
  83.       C := Random(15) + 1;
  84.       ExtCircleC(Graphics DIV 2, 100, I, C);
  85.       Dec(I, 4);
  86.     END;
  87.       GetAspect(X, Y);
  88.       FOR I := 1 TO 92 DO
  89.     BEGIN
  90.       IF Graphics = 320 THEN
  91.         BEGIN
  92.           D := Random(15) + 1;
  93.           SetAspect(15, 1);
  94.           ExtCircleC(Graphics DIV 2, 100, I, D);
  95.           SetAspect(1, 15);
  96.           ExtCircleC(Graphics DIV 2, 100, I, D);
  97.         END
  98.       ELSE
  99.         BEGIN
  100.           D := Random(15) + 1;
  101.           SetAspect(30, 1);
  102.           ExtCircleC(Graphics DIV 2, 100, I SHL 1, D);
  103.           SetAspect(1, 7);
  104.           ExtCircleC(Graphics DIV 2, 100, I, D);
  105.         END;
  106.     END;
  107.       SetAspect(X, Y);
  108.       WHILE Loop = True DO
  109.     BEGIN
  110.       CheckKey;
  111.       SetPalette(Random(15) + 1, 0);
  112.       Pause(2);
  113.       ResetPalette;
  114.     END;
  115.       IF EndProgram = False THEN
  116.     Loop := True;
  117.     END;
  118.   ExitGraphics;
  119.  
  120. END.
  121.