home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 15 / graphen / graphut.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-20  |  11.6 KB  |  359 lines
  1. PROCEDURE KordViewPort;
  2. { Definiert ein Graphikfenster für das Koordinatensystem }
  3. BEGIN
  4.       SetViewPort (UaxMin,GetMaxY-VaXmax,UaxMax,GetMaxY-VaxMin,ClipOn);
  5. END;
  6.  
  7. { ----------------------------------------------------------------------- }
  8.  
  9. PROCEDURE Umrechnung (x,y : Real; VAR xp,yp : Integer);
  10. BEGIN
  11.      Scale (x,y,xp,yp);
  12.      xp := xp - Uaxmin;
  13.      yp := yp - GetMaxY + VaXMax;
  14. END;
  15.  
  16. PROCEDURE Koordinatensystem (x1,x2,y1,y2 : Real; xBez, yBez : strg80);
  17. VAR x,y,dx,dy   : REAL;
  18.     xp,yp       : Integer;
  19.  
  20. BEGIN
  21.      x := x1 ; y := y1;
  22.      GraphikWindow (125,getmaxx,45,getmaxy-35);
  23.      Uscale (x1,x2,y1,y2,false,false,5); { hier VAR Parameter }
  24.  
  25.      SetTextStyle   (DefaultFont,HorizDir,1);
  26.  
  27.      x1 := x; y1 := y;
  28.  
  29.      Xaxis (x1,x2,xBez,0,1,dx);          { Skalierung der     }
  30.      xgrid (0);                          { x-Achse            }
  31.      Yaxis (y1,y2,yBez,0,1,dy);          { und der            }
  32.      Ygrid (0);                          { y-Achse            }
  33.  
  34.      { Punkte zeichnen }
  35.  
  36.      WHILE y1 > y DO y1 := y1 - dy;
  37.      WHILE x1 > x DO x1 := x1 - dx;
  38.  
  39.      y := y1;
  40.      y2 := y2 + dy; x2 := x2 + dx;
  41.      KordViewPort;
  42.      REPEAT
  43.            x := x1;
  44.            REPEAT
  45.                  Umrechnung (x,y,xp,yp);
  46.                  Line (xp-1,yp,xp+1,yp);
  47.                  Line (xp,yp-1,xp,yp+1);
  48.                  x := x + dx;
  49.            UNTIL x > x2;
  50.            y := y + dy;
  51.      UNTIL y > y2;
  52. END;
  53.  
  54. PROCEDURE WaehleKoordsys (VAR x1,x2,y1,y2 : Real; VAR xBez,yBez : Strg80);
  55. CONST Tab = 19;
  56.  
  57. PROCEDURE RealEingabe (x,y : Word; VAR Wert : Real);
  58. VAR s : Strg80;
  59.     Fehler : Integer;
  60.  
  61. BEGIN
  62.      REPEAT
  63.            GotoXY (x,y); ReadLn (s);
  64.            IF s <> '' THEN
  65.            BEGIN
  66.                 GotoXY (x,y); Write ('                    ');
  67.                 GotoXY (x,y); Write (s);
  68.                 Val (s,Wert,Fehler);
  69.            END ELSE Fehler := 0;
  70.            IF  Fehler <> 0 THEN Write (#07,' <-- Fehler');
  71.      UNTIL Fehler = 0;
  72. END;
  73.  
  74. PROCEDURE StrgEingabe (x,y : Word; VAR ss : Strg80);
  75. VAR s : Strg80;
  76. BEGIN
  77.      GotoXY (x,y); ReadLn (s);
  78.      IF s <> '' THEN ss := s;
  79. END;
  80.  
  81. PROCEDURE Abbruch;
  82. BEGIN
  83.     WriteLn;
  84.     Window (42,WhereY+4,79,23);
  85.     ClrScr;
  86.     WriteLn;
  87.     Writeln ('Beabsichtigter Fehler ! Wird mit');
  88.     WriteLn ('Programmabbruch bestraft');
  89.     HALT;
  90. END;
  91.  
  92. BEGIN
  93.      Window (42,5,79,23);
  94.      GotoXY (1,18); Write ('Zur Bestätigung Enter - Taste pressen');
  95.      GotoXY (1,1 );
  96.      WriteLn ('X - Anfangswert : ',x1);
  97.      WriteLn ('X - Endwert ... : ',x2);
  98.      WriteLn ('Y - Anfangswert : ',y1);
  99.      WriteLn ('Y - EndWert ... : ',y2);
  100.      WriteLn;
  101.      WriteLn ('X - Bezeichner  : ',xBez);
  102.      WriteLn ('Y - Bezeichner  : ',yBez);
  103.      RealEingabe (Tab,1,x1);
  104.      RealEingabe (Tab,2,x2);
  105.      IF x1 = x2 THEN Abbruch;
  106.      RealEingabe (Tab,3,y1);
  107.      RealEingabe (Tab,4,y2);
  108.      IF y1 = y2 THEN Abbruch;
  109.      StrgEingabe (Tab,6,xBez);
  110.      StrgEingabe (Tab,7,yBez);
  111. END;
  112.  
  113. PROCEDURE Fehler  (Fehlernummer : Integer);
  114.  
  115. CONST Fehlerarten : ARRAY [1 .. 5] OF String [20] =
  116.  
  117.                       ('kein Leerzeichen'   ,
  118.                        'kein Y-Wert'        ,
  119.                        'x-Wert fehlerhaft'  ,
  120.                        'y-Wert fehlerhaft'  ,
  121.                        'Datei gibt''s nicht');
  122.  
  123. VAR   c : Char;
  124.       k : Integer;
  125.  
  126. BEGIN
  127.      Write (#07);
  128.      { Fehlermeldung ausgeben }
  129.  
  130.      SetViewPort (0,GetMaxY-10,GetMaxX,GetMaxY,ClipOn);
  131.      OutTextXY (0,0, '- Fehler in ' + Datei_Name [DateiNr] + ' : ' +
  132.                       Fehlerarten [ Fehlernummer ] +
  133.                      '  <W> eiter, <A> bbruch : ');
  134.  
  135.      REPEAT                    { Tastendruck genuegt }
  136.            c := Upcase (ReadKey);
  137.      UNTIL c in ['W','A'];
  138.  
  139.      If c = 'A' THEN
  140.      BEGIN
  141.            CloseGraphik ;
  142.            Close (Datei);
  143.            HALT (1);
  144.      END;
  145.  
  146.      { Fehlermeldung löschen }
  147.      ClearViewPort;
  148.      KordViewPort;
  149. END;
  150.  
  151. { ---------------------------- Fehler ------------------------------------- }
  152.  
  153. PROCEDURE Verwandle ( s : Zeile; VAR x,y : Real; VAR Punkt : Boolean);
  154.  
  155. { Verwandelt den uebergebenen String s in die beiden Zahlenwerte x und y }
  156. { und prueft, ob es sich dabei um einen Punkt handelt, der markiert wer- }
  157. { soll.                                                                  }
  158.  
  159. VAR p,fx,fy : integer ;
  160.     xs,ys   : Zeile   ;
  161.  
  162. BEGIN
  163.     WHILE s[1] = ' ' DO s := Copy (s,2,255);  { Leerzeichen ueberlesen      }
  164.  
  165.     IF (s [1] = 'p') OR (s[1] = 'P') THEN     { es handelt sich um einen    }
  166.     BEGIN                                     { Punkt.                      }
  167.          s := Copy (s,2,255);
  168.          WHILE s[1] = ' ' DO s := Copy (s,2,255);  { s.o.                   }
  169.          Punkt := TRUE ;
  170.     END  ELSE Punkt := FALSE;
  171.  
  172.     p := pos (' ',s);                         { Trennzeichen suchen         }
  173.     IF p = 0 THEN Fehler (1)                  { kein Trennzeichen => Fehler }
  174.     ELSE
  175.     BEGIN
  176.          xs  := Copy (s,1,pred(p))  ;         { x - String vom y - String   }
  177.          ys  := Copy (s,succ(p),255) ;        { trennen                     }
  178.  
  179.          IF ys <> '' THEN
  180.          WHILE ys [1] = ' ' DO
  181.                   ys := Copy (ys,2,255);      { Leerzeichen ueberlesen      }
  182.  
  183.          IF ys = '' then Fehler(2)            { kein y - Wert => Fehler     }
  184.          ELSE
  185.          BEGIN
  186.               Val (xs,x,fx);                  { Verwandlung der Strings     }
  187.               Val (ys,y,fy);                  { in Zahlen                   }
  188.               IF fx <> 0 THEN Fehler (3);     { x - Wert konnte nicht kon-  }
  189.                                               {          vertiert werden    }
  190.               IF Fy <> 0 THEN Fehler (4);
  191.          END;
  192.     END;
  193. END;
  194.  
  195. { -------------------------- Verwandle ----------------------------------- }
  196.  
  197. PROCEDURE DateiEingabe (VAR Anzahl : Word);
  198.  
  199. VAR Datei  : Text    ;
  200.     i,x,y  : Byte    ;
  201.     Fertig : Boolean ;
  202.  
  203. BEGIN
  204.      Window (3,5,39,23); GotoXY (1,1);
  205.  
  206.      IF Anzahl > 0 THEN
  207.      BEGIN
  208.           { Im Wiederholungsfalle nur Anzeige der eingegebenen Dateien }
  209.           FOR i := 1 TO Anzahl DO WriteLn (i,' : ',Datei_Name [i]);
  210.           EXIT;
  211.      END
  212.      ELSE
  213.      BEGIN
  214.           { Ersteingabe }
  215.           Anzahl := 0;
  216.           Fertig := FALSE;
  217.  
  218.           REPEAT
  219.                 Anzahl := Anzahl + 1;
  220.                 Fertig := Anzahl = MaxDateiAnzahl;   { Abbruch für REPEAT }
  221.                 Write   (Anzahl,' : '); ReadLn (Datei_Name[Anzahl]);
  222.  
  223.                 IF Datei_Name [Anzahl] <> ''
  224.                 THEN
  225.                 BEGIN
  226.                      { Überprüfen, ob Eingabe zulässig }
  227.                      Assign ( Datei, Datei_Name [Anzahl]);
  228.  
  229.                      {$I-}                          { Fehlerueberwachung aus }
  230.                          Reset (Datei);
  231.                      {$I+}                          { und wieder ein         }
  232.  
  233.                      IF IOResult <> 0 then          { Resultat der Fehlerueberwachung }
  234.                      BEGIN
  235.                           { Datei existiert nicht, Eingabe unzulässig }
  236.                           y := WhereY;
  237.                           WriteLn (#07,' Datei existiert nicht,');
  238.                           WriteLn (    ' wiederhole Eingabe !');
  239.                           Delay  (2000);
  240.                           GotoXY (1,y-1);
  241.                           WriteLn ('                             ');
  242.                           WriteLn ('                             ');
  243.                           WriteLn ('                             ');
  244.                           GotoXY (1,y-1);
  245.                           Anzahl := Anzahl - 1;
  246.                      END
  247.                      ELSE
  248.                      BEGIN
  249.                           { Datei existiert, Eingabe zulässig }
  250.                           Close (Datei);
  251.                           { Klein- in Großbuchstaben verwandeln }
  252.                           { sieht nachher schöner aus           }
  253.                           FOR i := 1 TO Length (Datei_Name [Anzahl]) DO
  254.                               Datei_Name [Anzahl][i] := UpCase (Datei_Name [Anzahl][i]) ;
  255.                      END;
  256.                 END
  257.                 ELSE
  258.                 BEGIN
  259.                      Anzahl := Anzahl - 1;
  260.                      Fertig := TRUE;
  261.                 END;
  262.           UNTIL Fertig;
  263.      END;
  264.  
  265.      IF Anzahl <> MaxDateiAnzahl THEN
  266.      BEGIN
  267.           GotoXY (1,Anzahl+1);
  268.           Write ('   ');
  269.      END;
  270. END;
  271.  
  272. { ------------------------------------------------------------------------ }
  273.  
  274. PROCEDURE Markiere (x,y : Integer);
  275. CONST R = 3 {1} ;                { Geschmacksache R = 1 bei vielen Punkten }
  276. BEGIN                            {                R = 3 bei wenig  Punkten }
  277.    { PutPixel (x,y,White) }      { oder auch PutPixel bei vielen   Punkten }
  278.    Circle (x,y,r);
  279. END;
  280.  
  281. { ----------------------------------------------------------------------- }
  282.  
  283. PROCEDURE Einschaltmeldung;
  284. { Zeichnet u.a. einen Block auf dem Bildschirm }
  285. VAR i : Byte;
  286. BEGIN
  287.      ClrScr;
  288.      Write ('╒'); FOR i := 2 TO 79 DO Write ('═'); Write ('╕');
  289.      GotoXY (28,1); Write (' Wertetabellen darstellen ');
  290.      FOR i := 2 TO 23 DO
  291.      BEGIN
  292.           GotoXY (1 ,i); Write ('│');
  293.           GotoXY (40,i); Write ('│');
  294.           GotoXY (80,i); Write ('│');
  295.      END;
  296.      Write ('╘'); FOR i := 2 TO 79 DO Write ('═'); Write ('╛');
  297.      GotoXY (40,24); Write ('╧');
  298.      GotoXY (16,3); Write ('Dateinamen :');
  299.      GotoXY (51,3); Write ('Koordinatensystem :');
  300. END;
  301.  
  302. PROCEDURE Zeichne_Graph (DateiNr : Byte);
  303. BEGIN
  304.     { Meldung, welche Datei bearbeitet wird }
  305.     SetViewPort (0,0,UaxMin-20,GetMaxY,ClipOn);
  306.     SetTextStyle (0,0,1); SetTextJustify (LeftText,TopText);
  307.     OuttextXY (0,10*DateiNr + 20, Datei_Name [DateiNr]);
  308.     KordViewPort;
  309.  
  310.     Assign (Datei,Datei_Name [DateiNr] );
  311.     Reset (Datei);
  312.  
  313.     If not EOF (Datei) THEN
  314.     REPEAT
  315.           ReadLn    (datei,s);             { Einlesen des Strings        }
  316.           IF s <> '' THEN
  317.           BEGIN
  318.                Verwandle (s,x,y,Punkt);    { Verwandlung in die reellen  }
  319.                                            { Zahlen x und y und          }
  320.                                            { Konvertierung in das        }
  321.                                            { Bildschirmkoordinatensystem }
  322.                                            { für den ersten Punkt !!     }
  323.                Umrechnung (x,y,Xalt,Yalt);
  324.                IF Punkt THEN Markiere (Xalt,Yalt);
  325.           END;
  326.     UNTIL (NOT Punkt) OR Eof (Datei) ;
  327.     { Ende der Punkte }
  328.  
  329.     WHILE not EOF (Datei) DO
  330.     BEGIN
  331.        ReadLn    (datei,s);  { s.o.                       }
  332.        If (s <> '') AND NOT Punkt THEN  { Alter Kurvenzug }
  333.        BEGIN
  334.            Verwandle (s,x,y,Punkt);
  335.            Umrechnung (x,y,XNeu,Yneu);
  336.            { Endlich kann die Linie gezogen werden !    }
  337.            { Aus kompatibilitätsgründen wurde der Befehl}
  338.            { Line verwendet und nicht LineTo            }
  339.  
  340.            Line (Xalt,Yalt,Xneu,Yneu);
  341.            { Merken der Endpunkte = neue Anfangspunkte  }
  342.  
  343.            Xalt := Xneu;
  344.            Yalt := Yneu;
  345.        END
  346.        ELSE                             { Neuer Kurvenzug }
  347.        If NOT Eof (Datei) THEN          { Rest s.o.       }
  348.        BEGIN
  349.             ReadLn (Datei,s);
  350.             If s <> '' THEN
  351.             BEGIN
  352.                  Verwandle (s,x,y,Punkt);
  353.                  { Ein neuer Kurvenzug wird wie behandelt wie }
  354.                  { ein erster Punkt                           }
  355.                  Umrechnung (x,y,Xalt,Yalt);
  356.             END;
  357.        END;
  358.     END;   { WHILE }
  359. END;