home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / tricks / plotxx.inc < prev    next >
Encoding:
Text File  |  1990-11-07  |  4.6 KB  |  152 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   PLOTXX.PAS                           *)
  3. (*     gemeinsame Prozeduren zum Test als Include         *)
  4. (*         (c) 1991 Bernd Haendel & TOOLBOX               *)
  5. (* ------------------------------------------------------ *)
  6.  
  7.   PROCEDURE GrafMod;              { Grafikmodus einrichten }
  8.   VAR
  9.     GraphPath : STRING;
  10.   BEGIN
  11.     GraphPath := GetEnv('BGIPATH');
  12.     (* -------------------------------------------------- *)
  13.     (* Im Environment:                                    *)
  14.     (* SET BGIPATH=C:\TURBO\GRAPH                         *)
  15.     (* -------------------------------------------------- *)
  16.     GraphDriver := Detect;
  17.     InitGraph(GraphDriver, GraphMode, GraphPath);
  18.  
  19.     ModeName := GetModeName(GraphDriver);
  20.     GetModeRange(GraphDriver, MinMode, MaxMode);
  21.   END;
  22.  
  23.   PROCEDURE Farben;                 { Farben neu festlegen }
  24.   BEGIN
  25.     CASE KeyNr OF
  26.       59 : BEGIN
  27.              Inc(Color1);
  28.              IF Color1 > MaxColorV THEN Color1 := 0;
  29.            END;
  30.       60 : BEGIN
  31.              Inc(Color2);
  32.              IF Color2 > MaxColorV THEN Color2 := 0;
  33.            END;
  34.       61 : BEGIN
  35.              Inc(Color3);
  36.              IF Color3 > MaxColorV THEN Color3 := 0;
  37.            END;
  38.       62 : BEGIN
  39.              Inc(Color4);
  40.              IF Color4 > MaxColorV THEN Color4 := 0;
  41.            END;
  42.       63 : BEGIN
  43.              Inc(Color5);
  44.              IF Color5 > MaxColorH THEN Color5 := 0;
  45.            END;
  46.       64 : BEGIN
  47.              Inc(Color6);
  48.              IF Color6 > MaxColorV THEN Color6 := 0;
  49.            END;
  50.     END;
  51.   END;
  52.  
  53.   FUNCTION  TastKey : INTEGER;
  54.                        { Einlesen einer Tastaturbetätigung }
  55.   BEGIN
  56.     Key := Chr(32);  KeyNr := 0;
  57.     IF KeyPressed THEN BEGIN
  58.       Key := ReadKey;  KeyNr := Ord(Key);
  59.       WHILE KeyPressed DO BEGIN
  60.         Key := ReadKey;  KeyNr := Ord(Key);
  61.         IF (Key = Chr(0)) THEN BEGIN
  62.           Key := ReadKey;  KeyNr := Ord(Key);
  63.         END ELSE
  64.           KeyNr := Ord(Key);
  65.       END;
  66.     END;
  67.     TastKey := KeyNr;
  68.   END;
  69.  
  70.   PROCEDURE Erklaerung;          { Erklärung der F-Tasten  }
  71.   BEGIN
  72.     SetColor(Color6);
  73.     OutTextXY(10, 250, 'F1  Farbe 1');
  74.     OutTextXY(10, 260, 'F2  Farbe 2');
  75.     OutTextXY(10, 270, 'F3  Farbe 3');
  76.     OutTextXY(10, 280, 'F4  Farbe 4');
  77.     OutTextXY(10, 290, 'F5  Farbe 5');
  78.     OutTextXY(10, 300, 'F10 Ende   ');
  79.   END;
  80.  
  81.  
  82.   PROCEDURE KoordAchsen;     { Koordiantenachsen festlegen }
  83.   BEGIN
  84.     X0 := 320;   Y0 := 170;
  85.                              { Umrandung zeichnen }
  86.     SetColor(Color6);
  87.     MoveTo(  3,   3);  LineTo(636,   3);  LineTo(636, 346);
  88.     LineTo(  3, 346);  LineTo(  3,   3);
  89.     MoveTo(  4,   4);  LineTo(635,   4);  LineTo(635, 345);
  90.     LineTo(  4, 345);  LineTo(  4,   4);
  91.     MoveTo(  5,   5);  LineTo(  5, 344);
  92.     MoveTo(634,   5);  LineTo(634, 344);
  93.   END;
  94.  
  95.   PROCEDURE PlotLine(X1, Y1, X2, Y2 : REAL);
  96.        { Zeichnen einer geraden Linie von X1/Y1 nach X2/Y2 }
  97.   CONST
  98.     XF = 4.000;
  99.     YF = 3.100;
  100.   VAR
  101.     IX, IY : INTEGER;
  102.     XX, YY : REAL;
  103.   BEGIN
  104.     IX := X0 + Round(X1 * XF);
  105.     IY := Y0 - Round(Y1 * YF);  MoveTo(IX, IY);
  106.     IX := X0 + Round(X2 * XF);
  107.     IY := Y0 - Round(Y2 * YF);  LineTo(IX, IY);
  108.   END;
  109.  
  110.   FUNCTION  VZ(X1, X2 : REAL) : REAL;
  111.            { Vorzeichen für ein Geradeninkrement ermitteln }
  112.   BEGIN
  113.     IF X2 >= X1 THEN VZ := 1.00 ELSE VZ := -1.00;
  114.   END;
  115.  
  116.   PROCEDURE NeuerPunkt(X1, Y1, X2, Y2 : REAL);
  117.                { Neuen Anfangspunkt auf einer vorgegebenen }
  118.                { Geradenlinie ermitteln                    }
  119.   VAR
  120.     DXX, DYY, VZX, VZY : REAL;
  121.     DX, DY, DXY, SXX   : REAL;
  122.     DX1, DY1           : REAL;
  123.   BEGIN
  124.     DX := Abs(X2-X1);  DXX := DX*DX;  VZX := VZ(X1, X2);
  125.     DY := Abs(Y2-Y1);  DYY := DY*DY;  VZY := VZ(Y1, Y2);
  126.     IF DXX > 1.E-6 THEN BEGIN
  127.       DXY := DYY/DXX;  SXX := SX*SX;
  128.       DX1 := Sqrt(SXX/(1.0 + DXY));
  129.       DY1 := DY*Abs(DX1)/DX;
  130.     END ELSE BEGIN
  131.       DX1 := 0.00;  DY1 := SX;
  132.     END;
  133.     XXN := X1 + VZX*DX1; YYN := Y1 + VZY*DY1;
  134.   END;
  135.  
  136.   PROCEDURE HinterGrund;   { Setzen einer Hintergrundfarbe }
  137.   VAR
  138.     Kasten : ARRAY [1..5] OF PointType;
  139.   BEGIN
  140.      Kasten[1].X :=   0;  Kasten[1].y :=   0;
  141.      Kasten[2].X := 639;  Kasten[2].y :=   0;
  142.      Kasten[3].X := 639;  Kasten[3].y := 349;
  143.      Kasten[4].X :=   0;  Kasten[4].y := 349;
  144.      Kasten[5].X :=   0;  Kasten[5].y :=   0;
  145.  
  146.      SetFillStyle(SolidFill, Color5);
  147.      FillPoly(5, Kasten);
  148.   END;
  149.  
  150. (* ------------------------------------------------------ *)
  151. (*               Ende von PLOTXX.PAS                      *)
  152.