home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / tricks / plot01.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-11-07  |  3.9 KB  |  106 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   PLOT01.PAS                           *)
  3. (*          Plottergrafik : Quadratspirale                *)
  4. (*          Modus         : EGA 640 x 350                 *)
  5. (*                                                        *)
  6. (*         (c) 1991 Bernd Haendel & TOOLBOX               *)
  7. (* ------------------------------------------------------ *)
  8. {$N+,E+}
  9.  
  10. USES
  11.   Crt, Dos, Graph;
  12.  
  13. VAR
  14.   Color1, Color2, Color3, Color4 : WORD;
  15.   Color5, Color6                 : WORD;
  16.   Test                           : TEXT;
  17.   GraphDriver, GraphMode         : INTEGER;
  18.   MinMode, MaxMode, I, NN        : INTEGER;
  19.   X0, Y0, DX0, DY0, XX, YY       : INTEGER;
  20.   KeyNr, MaxColorV, MaxColorH    : INTEGER;
  21.   Key                            : CHAR;
  22.   ModeName                       : STRING;
  23.   SL, SX, S, SH                  : REAL;
  24.   X1, X2, X3, X4, XXN, DX1       : REAL;
  25.   Y1, Y2, Y3, Y4, YYN, DY1       : REAL;
  26.  
  27. {$I PLOTXX.INC }
  28.  
  29.   PROCEDURE AnfangsQuadrat;      { Anfangsquadrat zeichnen }
  30.   BEGIN
  31.     X1 := -SH;  Y1 := -SH;   X2 :=  SH;  Y2 := -SH;
  32.     X3 :=  SH;  Y3 :=  SH;   X4 := -SH;  Y4 :=  SH;
  33.     SetColor(Color1);  PlotLine(X1, Y1, X2, Y2);
  34.     SetColor(Color2);  PlotLine(X2, Y2, X3, Y3);
  35.     SetColor(Color3);  PlotLine(X3, Y3, X4, Y4);
  36.     SetColor(Color4);  PlotLine(X4, Y4, X1, Y1);
  37.     SetColor(Color6);
  38.     OutTextXY( 20,  10, 'Plot01');
  39.     OutTextXY( 20, 335, 'Quadratspirale');
  40.     OutTextXY(450, 335, 'B. Haendel & TOOLBOX');
  41.   END;
  42.  
  43.   PROCEDURE NeuesQuadrat;
  44.                       { Verkürtztes neues Quadrat zeichnen }
  45.   VAR
  46.     DX, DY             : REAL;
  47.     XX1, XX2, XX3, XX4 : REAL;
  48.     YY1, YY2, YY3, YY4 : REAL;
  49.   BEGIN
  50.     DX := Abs(X2-X1);  DY := Abs(Y2-Y1);
  51.     S  := Sqrt(DX*DX + DY*DY); SH := 0.50 * S;
  52.     NeuerPunkt(X1, Y1, X2, Y2);  XX1 := XXN;  YY1 := YYN;
  53.     NeuerPunkt(X2, Y2, X3, Y3);  XX2 := XXN;  YY2 := YYN;
  54.     NeuerPunkt(X3, Y3, X4, Y4);  XX3 := XXN;  YY3 := YYN;
  55.     NeuerPunkt(X4, Y4, X1, Y1);  XX4 := XXN;  YY4 := YYN;
  56.     X1 := XX1;  X2 := XX2;  X3 := XX3;  X4 := XX4;
  57.     Y1 := YY1;  Y2 := YY2;  Y3 := YY3;  Y4 := YY4;
  58.     SetColor(Color1);  PlotLine(X1, Y1, X2, Y2);
  59.     SetColor(Color2);  PlotLine(X2, Y2, X3, Y3);
  60.     SetColor(Color3);  PlotLine(X3, Y3, X4, Y4);
  61.     SetColor(Color4);  PlotLine(X4, Y4, X1, Y1);
  62.   END;
  63.  
  64. BEGIN
  65.   ClrScr;
  66.   Grafmod;                   { Grafikmodus setzen          }
  67.  
  68.   Color1 := Blue;            { Seitenfarbe 1               }
  69.   Color2 := Green;           { Seitenfarbe 2               }
  70.   Color3 := Magenta;         { Seitenfarbe 3               }
  71.   Color4 := Yellow;          { Seitenfarbe 4               }
  72.  
  73.   Color5 := Black;           { Hintergrundfarbe            }
  74.   Color6 := White;           { Schriftfarbe                }
  75.  
  76.   MaxColorV := 15;           { max. Vordergrundfarbe       }
  77.   MaxColorH :=  7;           { max. Hintergrundfarbe       }
  78.  
  79.   KoordAchsen;               { Koordinatenachse festlegen  }
  80.  
  81.   NN := 0;  KeyNr := 59;
  82.   WHILE KeyNr <> 68 DO BEGIN
  83.     IF (KeyNr > 58) AND (KeyNr < 65) THEN BEGIN
  84.       SL := 90.00;           { Seitenlänge des Quadrats    }
  85.       SX := 1.50;            { Verkürzung der Seitenlänge  }
  86.       SH := 0.50 * SL;
  87.       HinterGrund;           { Hintergrund füllen          }
  88.       Erklaerung;            { Erklärung der F-Tasten      }
  89.       AnfangsQuadrat;        { Anfangsquadrat zeichnen     }
  90.       WHILE SX < SH DO       { Jeweils verkleinertes neues }
  91.         NeuesQuadrat;        { Quadrat zeichnen }
  92.     END;
  93.     REPEAT UNTIL KeyPressed;
  94.     KeyNr := TastKey;
  95.     Farben;
  96.     Inc(NN); IF NN > 100 THEN KeyNr := 68;
  97.   END;
  98.  
  99.   CloseGraph;                   { Grafikmodus zurücksetzen }
  100.   TextColor(White);
  101.   TextBackGround(Black);        { bzW. auf alte Farben ... }
  102.   ClrScr;
  103. END.
  104. (* ------------------------------------------------------ *)
  105. (*                 Ende von PLOT01.PAS                    *)
  106.