home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 15 / graphen / reg / regutil.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-18  |  3.1 KB  |  88 lines
  1. { --------------------------------------------------------------- }
  2. {                   File : REGUTIL.PAS ( gehört zu REG.PAS )      }
  3. {          Copyright (c) : 1988  Heinz Hagemeyer & TOOLBOX        }
  4. {                Sprache : TURBO PASCAL 4.0  (oder 3.0)           }
  5. {              Ein Programm zur Auswertung von Meßwerten          }
  6. {                   mit Hilfe von GRAPH.PAS                       }
  7. { --------------------------------------------------------------- }
  8.  
  9. { Schreibt in die Datei REG.dat die Meßpunkte ein. Stellt den  x  }
  10. { und y - Werten ein 'P' voran.                                   }
  11.  
  12. PROCEDURE Punkte (n : Index ; VAR x,y : Messwerte ; VAR t : Text );
  13. VAR i : Index;
  14. BEGIN
  15.      FOR i := 1 TO n DO WriteLn (t,'P',x[i],' ',y[i] );
  16.      WriteLn (t);
  17. END;
  18.  
  19. { --------------------------------------------------------------- }
  20. {     Sucht die kleinste Zahl inerhalb des Arrays Meßwerte        }
  21.  
  22. FUNCTION Minimum (n1,n2 : Index; x : Messwerte) : Real ;
  23. VAR i,min : Index;
  24. BEGIN
  25.      min := n1;
  26.      FOR i := n1 + 1 TO n2 DO
  27.          IF x[i] < x[min] THEN min := i;
  28.      Minimum := x[min];
  29. END;
  30.  
  31. { --------------------------------------------------------------- }
  32. {                   dto. die größte Zahl                          }
  33.  
  34. FUNCTION Maximum (n1,n2 : Index; x : Messwerte) : Real ;
  35. VAR i,max : Index;
  36. BEGIN
  37.      max := n1;
  38.      FOR i := n1+1 TO n2 DO
  39.          IF x[i] > x[max] THEN max := i;
  40.      Maximum := x[max];
  41. END;
  42.  
  43. { --------------------------------------------------------------- }
  44. {                  Gibt Fehlermeldungen aus                       }
  45. PROCEDURE Fehler (FehlerNr : Byte);
  46. CONST Klingel = #07;
  47. VAR Art : STRING [11];
  48. BEGIN
  49.      Window (15,10,65,20);
  50.      ClrScr;
  51.      Window (17,11,64,20);
  52.      WriteLn (Klingel,'               Fehler :');
  53.  
  54.      CASE FehlerNr OF
  55.     1,4,5,6 : BEGIN
  56.                    WriteLn ('Lineare Regression nicht möglich.');
  57.                    WriteLn ('Ursache : Anzahl < 2 . (Gleiche Punkte dabei ');
  58.                    WriteLn ('nur einmal zählen.)');
  59.               END;
  60.           2 : BEGIN
  61.                    WriteLn ('Quadratische Regression nicht möglich.');
  62.                    WriteLn ('Ursache : Anzahl < 2 . (Gleiche Punkte dabei ');
  63.                    WriteLn ('nur einmal zählen.)');
  64.               END;
  65.           3 : BEGIN
  66.                    WriteLn ('Interpolation mit kubischen Splines nicht mög-');
  67.                    WriteLn ('lich. x - Wert doppelt eingegeben. Keine Funk-');
  68.                    WriteLn ('tion oder Anzahl der Werte > ',Spline_Max);
  69.               END;
  70.       END;
  71.  
  72.       CASE FehlerNr OF
  73.            4 : Art := 'Logarithmus';
  74.            5 : Art := 'Potenz';
  75.            6 : Art := 'Exponential';
  76.       END;
  77.  
  78.       IF FehlerNr > 3 THEN
  79.       BEGIN
  80.            WriteLn ('Gilt auch für die ',Art,'funktion, die auf');
  81.            WriteLn ('eine lineare Funktion zurückgeführt wird.');
  82.       END;
  83.       ReadLn;
  84. END;
  85.  
  86. { -------------------------------------------------------------------------- }
  87. { --                   Ende von REGUTIL.PAS                               -- }
  88.