Zurück

 

 

F A C H H O C H S C H U L E    W E D E L

 

Seminaraufgabe Pascal SS 96

 

Numerische Lösung von expliziten Differential-Gleichungen erster Ordnung

und grafische Darstellung der Lösungsfunktion

 

Programm DGL

 

Udo Becker

PI 6222

 

13. Januar 1997

 

Inhalt

Inhalt   Anfang

Einleitung

Das vorliegende Programm dient zur numerischen Lösung von expliziten Differential-Gleichungen erster Ordnung. Bei einfacheren Differential-Gleichungen bietet eine analytische Lösung zwar genauere Ergebnisse, jedoch lassen sich viele Differential-Gleichungen analytisch nicht lösen. In diesen Fällen kommt nun eine numerische Lösung durch Einschrittverfahren in Betracht. Als numerische Lösung erhält man x-y-Wertepaare in Form einer Wertetabelle, die durch das Programm als Funktion grafisch dargestellt werden.

Durch ein Einschrittverfahren werden aus vorhandenen Funktionswerten nachfolgende Nährungwerte berechnet. Als Voraussetzung für die Berechnung wird also ein Paar von x-y-Werten benötigt, man spricht von einem Anfangswertproblem.

Hierbei ist für die Genauigkeit der Berechnung die Schrittweite von entscheidender Bedeutung. Bei kleinerer Schrittweite werden im Prinzip genauere Werte berechnet, jedoch müssen in einem vorgegebenem Intervall mehr Berechnungen durchgeführt werden, so daß die Rundungsfehler zunehmen. Hieraus ergibt sich die Notwendigkeit einer Schrittweitensteuereung, die in diesem Programm mit den Einbettungsformeln von England nach dem Runge-Kutta-Verfahren durchgeführt wird.

Das Programm wurde in Borland Turbo Pascal 7.01 geschrieben.

Inhalt   Anfang

Programmbeschreibung

Startbildschirm

Das Hauptprogramm wurde als Turbo Vision Standard Objekt definiert, somit steht dem Benutzer eine für Turbo Vision Programme übliche Umgebung zur Verfügung. Die Bedienung kann mit der Maus oder über Tastatur erfolgen. Beim Start erscheint eine kurze Programminformation.

In der Menüleiste sind die Programmoptionen ‘Eingabe’, ‘Laden’, ‘T-Rechner’ und ‘Info’ sowie eine Uhr untergebracht. Die Statusleiste enthält Informationen über Tastaturbefehle.

Über ‘F10’ läßt sich die Menüleiste aktivieren. Die Programmoptionen könne ebenfalls mit der Tastenkombination ‘Alt+<Markierter Buchstabe>‘ aufgerufen werden. Mit der Escape-Taste lassen sich Fenster schließen.

Beendet wird das Programm mit der Tastenkombinatin ‘Alt+X’ oder mit der Maus durch anklicken von ‘Exit’.

Inhalt   Anfang

Eingabedialog

Im Eingabefenster wird der Benutzer aufgefordert, die zu lösende Differential-Gleichung in expliziter Form einzugeben. Diese muß in der im Pascal-Quellcode üblichen Schreibweise vorliegen. Der Ausdruck ‘dy/dx =‘ ist bereits vorgegeben und darf nicht eingegeben werden. Folgende Ausdrücke sind erlaubt:

x, y Variable
(, ) Klammern
0..9 Zahlen
+, -, *, / Grundrechenarten
sin, cos, tan, arctan trigonometrische Funktionenen
exp Exponentionalfunktion
ln natürlicher Logarithmus
log Logarithmus zur Basis 10
sqr Quadrat
sqrt Quadratwurzel
abs Betrag
int ganzzahliger Anteil
frac nichtganzzahliger Anteil

Erfolgt die Eingabe der Differential-Gleichung nicht in korrekter Weise wird der Benutzer durch eine Fehlermeldung aufgefordert, die Eingabe zu korrigieren.

Weiterhin müssen im Eingabefenster der x-Minimalwert, der x-Maximalwert, der y-Anfangswert sowie die Genauigkeitsschrake e eingegeben werden. In diesen Eingabefeldern werden nur Dezimalzahlen akzeptiert. Hier erfolgt ebenfalls eine Prüfung, ob korrekte Werte eingegeben wurden, die im negativen Fall eine Fehlermeldung hervorruft.

Das Eingabefenster enthält zwei Funktionsknöpfe: einen Abbruchknopf, der das Eingabefenster schließt, und einen einen Ok-Knopf, der die Berechnung und bei fehlerfreier Rechnung anschließend die Grafische Ausgabe der Funktion veranlaßt.

Fehler während der Berechnung wie z.B. Fließkommaüberläufe oder Divisionen durch Null erzeugen eine Fehlermeldung mit Angabe der entsprechenden x- und y-Werte, so daß der Benutzer den Auswertungsbereich der Funktion entsprechen anpassen kann.

Beim Öffnen des Eingabefensters werden in die Eingabefelder automatisch die Parameter der letzten Berechnung aus der Datei DGL.PAR geladen, ebenfalls werden die Parameter beim schließen des Eingabefensters in dieser Datei gespeichert.

Inhalt   Anfang

Grafische Ausgabe

Nach der Berechnung oder nachdem eine bereits vorhandene Datei geladen wurde erfolgt die grafische Ausgabe. Hier wird die Funktion in einem nach den Minimal- und Maximalwerten skalierten Koordinatensystem dargestellt.

Der Grafik-Bildschirm kann mit der Escape-Taste beendet werden.

Inhalt   Anfang

Speichern

Wurde eine Funktion berechnet und grafisch dargestellt wird der Benutzer gefragt, ob er die Für eine erneute Darstellung der Funktion benötigten Daten abspeichern möchte.

Für das Abspeichern der Darstellungs-Daten wird ein Turbo Vision Standard Dialog verwendet, der es dem Benutzer erlaubt, die Datei an einer beliebigen Stelle in seinem Dateisystem abzulegen. Für die zu speichernden Dateien sollte die Erweiterung ‘* .DGL’ verwendet werden, die auch vorgegeben wird.

Ist bereits eine Datei mit dem gewähltem Namen vorhanden wird gefragt, ob diese überschrieben werden soll.

Inhalt   Anfang

Laden

Der Lade-Dialog ist ebenfalls ein Turbo Vision Standard Dialog. Der Benutzer kann sein Dateisystem nach Dateien mit der Erweiterung ‘* .DGL’ durchsuchen und diese laden. Wird eine Funktion geladen erfolgt die grafische Ausgabe.

Inhalt   Anfang

Taschenrechner

Die Auswahl ‘T-Rechner’ gibt einen einfachen Taschenrechner aus einer Turbo Vision Standard Unit auf den Bildschirm.

Inhalt   Anfang

Information

Unter ‘Info’ erhält man eine kurze Programminformation.

Inhalt   Anfang

Programmlistings

Program DGL

 
{-------------------------------------------------------------------------}

{ Programm zur numerischen L”sung von expliziten Differential-Gleichungen
  erster Ordnung
  Udo Becker 1996/97 }

program DGL;

{$X+}
{$S+}
{$M 65520,8192,655360}

{-------------------------------------------------------------------------}

uses
  DGLGlob, Etc, Input, LoadSave,

  { Turbo Pascal Standard Units }
  App, Drivers, Gadgets, Memory, Menus, Objects, Views;

type
  TDGL = object(TApplication)
    Clock : PClockView;
    Heap  : PHeapView;
    constructor Init;
    procedure HandleEvent(var Event : TEvent); virtual;
    procedure Idle; virtual;
    procedure InitMenuBar; virtual;
    procedure InitStatusLine; virtual;
  end;

const
  HeapSize = 48 * (1024 div 16); { 48k Heap }

{-------------------------------------------------------------------------}

{ Initialisierung }
constructor TDGL.Init;

var
  R : TRect;

begin
  MaxHeapSize := HeapSize;
  inherited Init;
  GetExtent(R);
  R.A.X := R.B.X - 9;
  R.B.Y := R.A.Y + 1;
  Clock := New(PClockView, Init(R));
  Insert(Clock);
  GetExtent(R);
  Dec(R.B.X);
  R.A.X := R.B.X - 9;
  R.A.Y := R.B.Y - 1;
  Heap := New(PHeapView, Init(R));
  Insert(Heap);
  Info;
end; { Init }

{-------------------------------------------------------------------------}

{ Auswahl der Handlungsm”glichkeiten }
procedure TDGL.HandleEvent(var Event: TEvent);

begin
  inherited HandleEvent(Event);
  case Event.What of evCommand:
    begin
      case Event.Command of
        cmEingabe : Eingabe;
        cmLaden   : Laden;
        cmRechner : Rechner;
        cmInfo    : Info;
      else
        Exit;
      end;
      ClearEvent(Event);
    end;
  end;
end; { HandleEvent }

{-------------------------------------------------------------------------}

{ Uhrzeit und Speicherbelegung aktualisieren }
procedure TDGL.Idle;

begin
  inherited Idle;
  Clock^.Update;
  Heap^.Update;
end; { Idle }

{-------------------------------------------------------------------------}

{ Menleiste }
procedure TDGL.InitMenuBar;

var
  R : TRect;

begin
  GetExtent(R);
  R.B.Y := R.A.Y+1;
  MenuBar := New(PMenuBar, Init(R, NewMenu(
    NewItem('~E~ingabe', '', kbNoKey, cmEingabe, hcEingabe,
    NewItem('~L~aden', '', kbNoKey, cmLaden, hcLaden,
    NewItem('~T~-Rechner', '', kbNoKey, cmRechner, hcRechner,
    NewItem('~I~nfo', '', kbNoKey, cmInfo, hcInfo,
    nil)))))));
end; { InitMenuBar }

{-------------------------------------------------------------------------}

{ Statuszeile }
procedure TDGL.InitStatusLine;

var
  R : TRect;

begin
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine := New(PStatusLine, Init(R,
    NewStatusDef(0, $FFFF,
      NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
      NewStatusKey('~F10~ Menu', kbF10, cmMenu,
      NewStatusKey('~Esc~ Fenster schlieáen', kbEsc, cmClose,
      nil))),
    nil)));
end; { InitStatusLine }

{-------------------------------------------------------------------------}

var
  DG : TDGL;

begin { DGL }
  with DG do
  begin
    Init;
    Run;
    Done;
  end;
end. { DGL }

{-------------------------------------------------------------------------}

Inhalt   Anfang

Unit DGLGlob

 
{-------------------------------------------------------------------------}

{ Deklarierung globaler Typen, Konstanten, Variablen, Funktionen und
  Prozeduren }
unit DGLGlob;

{$D-}

{-------------------------------------------------------------------------}

interface

type
  RParameter = record
    DGLEingabe : string;
    Eingaben   : array [0..3] of string [12];
  end;
  DarstellWerte = record
    x, y : word;
  end;

const
  cmInfo    = 1002;
  cmRechner = 1006;
  cmEingabe = 1007;
  cmLaden   = 1008;
  hcRechner = 4;
  hcInfo    = 8;
  hcEingabe = 21;
  hcLaden   = 22;
  dw_max    = 5000;

var
  Parameter                        : RParameter;
  DiffGl                           : string;
  x_min, x_max, y_anfang, e        : real;
  nd                               : word;
  dw                               : array [0..dw_max] of DarstellWerte;
  Skala                            : array [0..11] of word;
  n_xBeschriftung, n_yBeschriftung : byte;
  x_Beschriftung, y_Beschriftung   : array [0..9] of string;
  FormelCode                       : array [0..1000] of word;
  Fehler, FehlerCode               : integer;
  Ok                               : boolean;

function Exists(Fn : string) : boolean;
procedure ValueR(Param : string; var a : real);
procedure ValueI(Param : string; var i : integer);

{-------------------------------------------------------------------------}

implementation

{--------------------------------------------------------------------------}

{ Prfung ob eine Datei vorhanden ist }
function Exists(Fn : string) : boolean;

var
  Datei : file;

begin
  Assign(Datei, Fn);
  {$I-}
  Reset(Datei);
  {$I+}
  if IOResult = 0 then
  begin
    Exists := true;
    Close(Datei);
  end
  else Exists := false;
end; { Exists }

{--------------------------------------------------------------------------}

{ Konvertierung eines String in einen Real-Wert }
procedure ValueR(Param : string; var a : real);

begin
  Val(Param, a, Fehler);
  Ok := Ok and (Fehler = 0)
end; { ValueR }

{-------------------------------------------------------------------------}

{ Konvertierung eines String in einen Integer-Wert }
procedure ValueI(Param : string; var i : integer);

begin
  Val(Param, i, Fehler);
  Ok := OK and (Fehler = 0)
end;

{-------------------------------------------------------------------------}

end. { DGLGlob }

{--------------------------------------------------------------------------}

Inhalt   Anfang

Unit Input

 
{-------------------------------------------------------------------------}

{ Eingabe-Dialog und Prfung der Eingaben }
unit Input;

{-------------------------------------------------------------------------}

interface

uses
  Anzeige, Compil, DGLGlob, LoadSave, Rechnung,

  { Turbo Pascal Standard Units }
  App, Dialogs, MsgBox, Objects, Views;

procedure Eingabe;

{-------------------------------------------------------------------------}

implementation

{-------------------------------------------------------------------------}

{ Eingabe-Dialog und Prfung der Eingaben }
procedure Eingabe;

var
  R        : TRect;
  D, DD    : PDialog;
  Bruce    : PView;
  Command  : word;
  Strng    : string;
  AnzBytes : integer;

begin

  { Laden der Parameter fr das Eingabefenster }
  ParFileRead;

  repeat

    { Parameter der letzten Rechnung }
    Parameter.DGLEingabe := DiffGl;
    Str(x_min: 8: 4, Parameter.Eingaben[0]);
    Str(x_max: 8: 4, Parameter.Eingaben[1]);
    Str(y_anfang: 8: 4, Parameter.Eingaben[2]);
    Str(e: 11: 10, Parameter.Eingaben[3]);

    { Eingabefenster }
    R.Assign(3, 4, 77, 18);
    DD := New(PDialog,Init(R,'Eingabe'));
    DD^.HelpCtx := hcEingabe;
    with DD^ do
    begin

      { Feld fr Differential-Gleichung }
      R.Assign(11, 3, 71, 4);
      Bruce := New(PInputLine, Init(R, 255));
      Insert(Bruce);
      Strng := 'dy/dx =';
      R.Assign(2, 3, 3+Length(Strng), 4);
      Insert(New(PLabel, Init(R, Strng, Bruce)));
      Strng := 'Differential-Gleichung:';
      R.Assign(26, 2, 27+Length(Strng), 3);
      Insert(New(PStaticText, Init(R, Strng)));

      { Felder fr x-Wertebereich }
      R.Assign(32, 5, 46, 6);
      Bruce := New(PInputLine, Init(R, 12));
      Insert(Bruce);
      Strng := 'x_min =';
      R.Assign(20, 5, 21+Length(Strng), 6);
      Insert(New(PLabel, Init(R, Strng, Bruce)));
      R.Assign(57, 5, 71, 6);
      Bruce := New(PInputLine, Init(R, 12));
      Insert(Bruce);
      Strng := 'x_max =';
      R.Assign(48, 5, 49+Length(Strng), 6);
      Insert(New(PLabel, Init(R, Strng, Bruce)));
      Strng := 'x-Wertebereich:';
      R.Assign(3, 5, 3+Length(Strng), 6);
      Insert(New(PStaticText, Init(R, Strng)));

      { Feld fr y-Anfangswert }
      R.Assign(32, 7, 46, 8);
      Bruce := New(PInputLine, Init(R, 12));
      Insert(Bruce);
      Strng := 'y(x_min) =';
      R.Assign(20, 7, 21+Length(Strng), 8);
      Insert(New(PLabel, Init(R, Strng, Bruce)));
      Strng := 'y-Anfangswert:';
      R.Assign(3, 7, 4+Length(Strng), 8);
      Insert(New(PStaticText, Init(R, Strng)));

      { Feld fr Genauigkeit }
      R.Assign(32, 9, 46, 10);
      Bruce := New(PInputLine, Init(R, 12));
      Insert(Bruce);
      Strng := 'e =';
      R.Assign(20, 9, 21+Length(Strng), 10);
      Insert(New(PLabel, Init(R, Strng, Bruce)));
      Strng :=  'Genauigkeit:';
      R.Assign(3, 9, 4+Length(Strng), 10);
      Insert(New(PStaticText, Init(R, Strng)));

      { Buttons }
      R.Assign(21, 11, 31, 13);
      Insert(New(PButton, Init(R, '~B~ild', cmOk, bfDefault)));
      R.Assign(43, 11, 53, 13);
      Insert(New(PButton, Init(R, '~E~nde', cmCancel, bfNormal)));

      { Parameter einfgen }
      SetData(Parameter);

      Command := DeskTop^.ExecView(DD);
      if Command <> cmCancel then
      begin

        { Parameter einlesen }
        GetData(Parameter);
        Ok := true;
        DiffGl := Parameter.DGLEingabe;
        ValueR(Parameter.Eingaben[0], x_min);
        ValueR(Parameter.Eingaben[1], x_max);
        ValueR(Parameter.Eingaben[2], y_anfang);
        ValueR(Parameter.Eingaben[3], e);
        Ok := Ok and (x_min < x_max);

      end
      else Ok := false;

      if (Command = cmOk) and Ok then
      begin

        { Formel-Code erzeugen }
        Compile(DiffGl, FormelCode, SizeOf(FormelCode), true, Fehler,
          AnzBytes);

        if Fehler = 0 then
        begin

          { Berechnung der N„hrung und der Darstellungs-Daten }
          Berechnung;

          if FehlerCode = 0 then
          begin

            { Grafik-Ausgabe }
            Grafik;

            { Option zum Speichern der Darstellungs-Daten }
            R.Assign(0, 0, 45, 9);
            D := New(PDialog, Init(R,'Speichern ?'));
            with D^ do
            begin
              Options := Options or ofCentered;
              R.Grow(-1, -1);
              Dec(R.B.Y, 3);
              Insert(New(PStaticText, Init(R, #13+^C'Daten speichern ?')));
              R.Assign(9, 6, 19, 8);
              Insert(New(PButton, Init(R, '~J~a', cmYes, bfDefault)));
              R.Assign(25, 6, 35, 8);
              Insert(New(PButton, Init(R, '~N~ein', cmNo, bfNormal)));
            end;
            Command := Desktop^.ExecView(D);
            if (Command = cmYes) then Speichern;
            Dispose(D, Done);

          end;
        end;
      end;
      if (Command = cmOk) and not Ok then
        MessageBox(#3+'Eingabefehler:'+#13+#3+'alle Werte Zahlen ?'+
          #13+#3+'x_min < x_max ?', nil, mfError or mfOkButton);
    end;
    Dispose(DD, Done)
  until (Command = cmCancel);

  { Speichern der Parameter aus dem Eingabefenster }
  ParFileWrite;

end; { Eingabe }

{-------------------------------------------------------------------------}

end. { Input }

{-------------------------------------------------------------------------}

Inhalt   Anfang

Unit Rechnung

 
{-------------------------------------------------------------------------}

{ Berechnung der N„hrung und der Darstellungs-Daten }
unit Rechnung;

{-------------------------------------------------------------------------}

interface

uses
  Compil, DGLGlob, Error,

  { Turbo Pascal Standard Units }
  MsgBox, Objects;

procedure DarstellBer;
procedure SkalaBer;
procedure Naehrung;
procedure Berechnung;

{-------------------------------------------------------------------------}

implementation

var
  x_next, x_last, x_skal, x_minskal, x_maxskal, x_faktor,
  y_next, y_last, y_skal, y_minskal, y_maxskal, y_faktor,
  y_min, y_max                                            : real;

{-------------------------------------------------------------------------}

{ Berechnung Darstellungs-Daten fr die Funktion mit erneuter Berechnung
  der N„hrung }
procedure DarstellBer;

var
  i, x_tmp, y_tmp                      : integer;
  h, s, y4, y5, k1, k2, k3, k4, k5, k6 : real;

begin
  i := 1;
  dw[0].x := round((x_min-x_minskal)*x_faktor)+19;
  dw[0].y := -(round((y_anfang-y_minskal)*y_faktor)-419)+19;
  x_last := x_min;
  y_last := y_anfang;
  h := (x_max-x_min)/100;
  repeat
    repeat

      { n„chster x-Wert }
      x_next := x_last + h;

      { K-Werte }
      k1 := Rechne(FormelCode, x_last, y_last);
      k2 := Rechne(FormelCode, x_last+h/2, y_last+h*k1/2);
      k3 := Rechne(FormelCode, x_last+h/2, y_last+h*(k1+k2)/4);
      k4 := Rechne(FormelCode, x_last+h, y_last+h*(-k2+2*k3));
      k5 := Rechne(FormelCode, x_last+2*h/3, y_last+h*(7*k1+10*k2+k4)/27);
      k6 := Rechne(FormelCode, x_last+h/5,
              y_last+h*(28*k1-125*k2+546*k3+54*k4-378*k5)/625);

      { N„hrung 4. Ordnung }
      y4 := y_last+h*(k1+4*k3+k4)/6;

      { N„hrung 5. Ordnung }
      y5 := y_last+h*(14*k1+35*k4+162*k5+125*k6)/336;

      { s-Parameter }
      if y4 = y5 then s := 1 else s := sqrt(sqrt(h*e/abs(y4-y5)));

      { Schrittweite h verkleinern }
      if s < 1 then if s > 1/2 then h := s*h else h := h/2;

      { Schrittweite h zu klein, endlose Rekursion vermeiden }
      if h < (x_max-x_min)/1000000 then h := (x_max-x_min)/1000000;

    until (s >= 1) or (h  <= (x_max-x_min)/999999);

    { berechneten y-Wert bernehmen }
    y_next := y5;

    { Schrittweite h vergrӇern }
    if s >= 1 then if s < 2 then h := s*h else h := 2*h;

    x_last := x_next;
    y_last := y_next;

    { Darstellungs-Daten bestimmen }
    x_tmp := round((x_next-x_minskal)*x_faktor)+19;
    y_tmp := -(round((y_next-y_minskal)*y_faktor)-419)+19;
    if (x_tmp <> dw[i-1].x) or (y_tmp <> dw[i-1].y) then
    begin
      dw[i].x := x_tmp;
      dw[i].y := y_tmp;
      inc(i);
    end;

  until (x_last >= x_max) or (i = dw_max);
  nd := i-1;
end; { DarstellBer }

{-------------------------------------------------------------------------}

{ Berechnung der Darstellungs-Daten fr das Koordinaten-System }
procedure SkalaBer;

{-------------------------------------------------------------------------}

{ Berechnung von Zehnerpotenzen aus dem Exponenten }
function Zehnerpotenz(Exponent : integer) : real;

var
  i        : integer;
  Ergebnis : real;
  Strng    : string;

begin
  Strng := '1';
  if Exponent > 0 then for i := 1 to Exponent do Strng := Strng+'0';
  if Exponent < -1 then for i := -2 downto Exponent do Strng := '0'+Strng;
  if Exponent < 0 then Strng := '0.'+Strng;
  ValueR(Strng, Ergebnis);
  Zehnerpotenz := Ergebnis;
end; { Zehnerpotenz }

{-------------------------------------------------------------------------}

var
  i, sig, exp     : integer;
  skalmitte, tmpR : real;
  tmpS            : string [24];
  abschneiden     : boolean;

begin { SkalBer }

  { x-Skalenweite }
  tmpR := (x_max-x_min)/8;
  str(tmpR, tmpS);
  ValueI(copy(tmpS, 2, 1), sig);
  ValueI(copy(tmpS, 19, 5), exp);
  case sig of
    0    : x_skal := 1;
    1    : x_skal := 2;
    2..4 : x_skal := 5;
    5..9 : x_skal := 10;
  end;
  x_skal := x_skal*(Zehnerpotenz(exp));

  { Mitte der x-Skala }
  skalmitte := (x_min+x_max)/2;
  if skalmitte >= 0 then
  begin
    tmpR := -x_skal;
    repeat
      tmpR := tmpR+x_skal;
    until skalmitte-tmpR <= 0;
    skalmitte := tmpR;
  end
  else
  begin
    tmpR := x_skal;
    repeat
      tmpR := tmpR-x_skal;
    until skalmitte-tmpR >= 0;
    skalmitte := tmpR;
  end;

  { x-Minimal- und -Maximal-Skalenwert }
  x_minskal := skalmitte;
  repeat
    x_minskal := x_minskal-x_skal;
  until x_minskal < x_min+0.1*x_skal;
  x_maxskal := skalmitte;
  repeat
    x_maxskal := x_maxskal+x_skal;
  until x_maxskal > x_max-0.1*x_skal;

  { x-Skalenbeschriftung }
  i := 0;
  tmpR := x_minskal;
  repeat
    tmpR := tmpR+x_skal;
    if abs(tmpR) > 0.5*x_skal then
    begin
      Str(tmpR, tmpS);
      if exp < 0 then
      begin
        if copy(tmpS, 4-exp, 1) = '9' then
        begin
          tmpR := tmpR+0.1*Zehnerpotenz(exp);
          Str(tmpR, tmpS);
        end;
        x_Beschriftung[i] :=
          copy(tmpS, 1, 3-exp)+copy(tmpS, 18, 2)+copy(tmpS, 22, 2);
      end
      else x_Beschriftung[i] :=
        copy(tmpS, 1, 4)+copy(tmpS, 18, 2)+copy(tmpS, 22, 2);
    end
    else
    begin
      tmpR := 0;
      x_Beschriftung[i] := '';
    end;
    inc(i);
  until tmpR >= x_maxskal-0.5*x_skal;
  n_xBeschriftung := i-1;

  { nichtsignifikante x-Stellen abschneiden }
  repeat
    abschneiden := false;
    if length(x_Beschriftung[i]) > 8 then
    begin
      i := -1;
      repeat
        abschneiden := false;
        inc(i);
        if copy(x_Beschriftung[i], length(x_Beschriftung[i])-4, 1) = '0'
          then abschneiden := true;
      until (abschneiden = false) or (i = n_xBeschriftung);
      abschneiden := false;
      if i = n_xBeschriftung then
      begin
        abschneiden := true;
        for i := 0 to n_xBeschriftung do x_Beschriftung[i] :=
          copy(x_Beschriftung[i], 1, length(x_Beschriftung[i])-5)+
          copy(x_Beschriftung[i], length(x_Beschriftung[i])-3, 4);
      end;
    end;
  until (abschneiden = false);

  { y-Skalenweite }
  tmpR := (y_max-y_min)/8;
  str(tmpR, tmpS);
  ValueI(copy(tmpS, 2, 1), sig);
  ValueI(copy(tmpS, 19, 5), exp);
  case sig of
    0    : y_skal := 1;
    1    : y_skal := 2;
    2..4 : y_skal := 5;
    5..9 : y_skal := 10;
  end;
  y_skal := y_skal*(Zehnerpotenz(exp));

  { Mitte der y-Skala }
  skalmitte := (y_min+y_max)/2;
  if skalmitte >= 0 then
  begin
    tmpR := -y_skal;
    repeat
      tmpR := tmpR+y_skal;
    until skalmitte-tmpR <= 0;
    skalmitte := tmpR;
  end
  else
  begin
    tmpR := y_skal;
    repeat
      tmpR := tmpR-y_skal;
    until skalmitte-tmpR >= 0;
    skalmitte := tmpR;
  end;

  { y-Minimal- und -Maximal-Skalenwert }
  y_minskal := skalmitte;
  repeat
    y_minskal := y_minskal-y_skal;
  until y_minskal < y_min+0.1*y_skal;
  y_maxskal := skalmitte;
  repeat
    y_maxskal := y_maxskal+y_skal;
  until y_maxskal > y_max-0.1*y_skal;

  { y-Skalenbeschriftung }
  i := 0;
  tmpR := y_minskal;
  repeat
    tmpR := tmpR+y_skal;
    if abs(tmpR) > 0.5*y_skal then
    begin
      Str(tmpR, tmpS);
      if exp < 0 then
      begin
        if copy(tmpS, 4-exp, 1) = '9' then
        begin
          tmpR := tmpR+0.1*Zehnerpotenz(exp);
          Str(tmpR, tmpS);
        end;
        y_Beschriftung[i] :=
          copy(tmpS, 1, 3-exp)+copy(tmpS, 18, 2)+copy(tmpS, 22, 2);
      end
      else y_Beschriftung[i] :=
        copy(tmpS, 1, 4)+copy(tmpS, 18, 2)+copy(tmpS, 22, 2);
    end
    else
    begin
      tmpR := 0;
      y_Beschriftung[i] := '';
    end;
    inc(i);
  until tmpR >= y_maxskal-0.5*y_skal;
  n_yBeschriftung := i-1;

  { nichtsignifikante y-Stellen abschneiden }
  repeat
    abschneiden := false;
    if length(y_Beschriftung[i]) > 8 then
      begin
      i := -1;
      repeat
        abschneiden := false;
        inc(i);
        if copy(y_Beschriftung[i], length(y_Beschriftung[i])-4, 1) = '0'
          then abschneiden := true;
      until (abschneiden = false) or (i = n_yBeschriftung);
      abschneiden := false;
      if i = n_yBeschriftung then
      begin
        abschneiden := true;
        for i := 0 to n_yBeschriftung do y_Beschriftung[i] :=
          copy(y_Beschriftung[i], 1, length(y_Beschriftung[i])-5)+
          copy(y_Beschriftung[i], length(y_Beschriftung[i])-3, 4);
      end;
    end;
  until (abschneiden = false);

  { Umrechnungsfaktoren fr Bildschirmdarstellung }
  x_faktor := 600/(x_maxskal-x_minskal);
  y_faktor := 420/(y_maxskal-y_minskal);

  { x-Achse }
  if x_minskal < 0.5*x_skal then Skala[0] := 19 else Skala[0] := 39;
  if y_minskal > -0.5*y_skal then Skala[1] := 439
  else if y_maxskal < 0.5*y_skal then Skala[1] := 19
    else Skala[1] := -(round((-y_minskal)*y_faktor)-419)+19;
  if x_maxskal > -0.5*x_skal  then Skala[2] := 619 else Skala[2] := 599;

  { y-Achse }
  if x_minskal > -0.5*x_skal then Skala[3] := 19
  else if x_maxskal < 0.5*x_skal then Skala[3] := 619
    else Skala[3] := round((-x_minskal)*x_faktor)+19;
  if y_maxskal > -0.5*y_skal then Skala[4] := 19 else Skala[4] := 39;
  if y_minskal < 0.5*y_skal then Skala[5] := 439 else Skala[5] := 419;

  { Skalierungsfaktoren }
  Skala[6] := round(x_skal*x_faktor);
  Skala[7] := round(y_skal*y_faktor);

end; { SlalaBer }

{-------------------------------------------------------------------------}

{ Berechnung der N„hrung }
procedure Naehrung;

var
  h, s, y4, y5, k1, k2, k3, k4, k5, k6 : real;

begin
  y_min := y_anfang;
  y_max := y_anfang;
  x_last := x_min;
  y_last := y_anfang;
  h := (x_max-x_min)/100;
  repeat
    repeat

      { n„chster x-Wert }
      x_next := x_last + h;

      { K-Werte }
      k1 := Rechne(FormelCode, x_last, y_last);
      k2 := Rechne(FormelCode, x_last+h/2, y_last+h*k1/2);
      k3 := Rechne(FormelCode, x_last+h/2, y_last+h*(k1+k2)/4);
      k4 := Rechne(FormelCode, x_last+h, y_last+h*(-k2+2*k3));
      k5 := Rechne(FormelCode, x_last+2*h/3, y_last+h*(7*k1+10*k2+k4)/27);
      k6 := Rechne(FormelCode, x_last+h/5,
              y_last+h*(28*k1-125*k2+546*k3+54*k4-378*k5)/625);

      { N„hrung 4. Ordnung }
      y4 := y_last+h*(k1+4*k3+k4)/6;

      { N„hrung 5. Ordnung }
      y5 := y_last+h*(14*k1+35*k4+162*k5+125*k6)/336;

      { s-Parameter }
      if y4 = y5 then s := 1 else s := sqrt(sqrt(h*e/abs(y4-y5)));

      { Schrittweite h verkleinern }
      if s < 1 then if s > 1/2 then h := s*h else h := h/2;

      { Schrittweite h zu klein, endlose Rekursion vermeiden }
      if h < (x_max-x_min)/1000000 then h := (x_max-x_min)/1000000;

    until (s >= 1) or (h  <= (x_max-x_min)/999999);

    { berechneten y-Wert bernehmen }
    y_next := y5;

    { Schrittweite h vergrӇern }
    if s >= 1 then if s < 2 then h := s*h else h := 2*h;

    { y-Grenzen }
    if y_next < y_min then y_min := y_next;
    if y_next > y_max then y_max := y_next;

    x_last := x_next;
    y_last := y_next;

  until x_last >= x_max;
end; { Naehrung }

{-------------------------------------------------------------------------}

{ Prfung ob Rechnung durchgefhrt werden kann und Start der Rechnung }
procedure Berechnung;

var
  Strng, Strng1, Strng2 : string;

begin
  FehlerCode := SetExit(CpuPointer);
  case FehlerCode of
    0   : begin
            Naehrung;
            SkalaBer;
            DarstellBer;
          end;
    200 : Strng := 'Division durch 0';
    205 : Strng := 'Flieákommaberlauf';
    206 : Strng := 'Flieákommazahl zu klein';
    207 : Strng := 'Unzul„ssige Werte'
    else  Strng := 'Rechenfehler unbekannter Art'
  end;
  if FehlerCode <> 0 then
  begin
    Str(x_last: 8: 3, Strng1);
    Strng1 := 'x = ' + Strng1;
    Str(y_last: 8: 3, Strng2);
    Strng2 := 'y = ' + Strng2;
    MessageBox(#3+Strng+#13+#3+Strng1+#13+#3+Strng2, nil,
      mfError or mfOKButton);
  end;
end; { Berechnung }

{-------------------------------------------------------------------------}

end. { Rechnung }

{-------------------------------------------------------------------------}

Inhalt   Anfang

Unit Compil

 
{-------------------------------------------------------------------------}

{ Erzeugung des Formel-Codes aus der Differential-Gleichung und Berechnung
  der K-Werte mit dem Formel-Code }
unit Compil;

{-------------------------------------------------------------------------}

interface

uses
  DGLGlob, Error,

  { Turbo Pascal Standard Units }
  MsgBox, Objects, Views;

function Rechne(var Code; x, y : real): real;
procedure Compile(var Ausdruck; var Code; Size : integer;
  Meldung : boolean; var ErrPos, Pc : integer);

{-------------------------------------------------------------------------}

implementation

var
  CpuSave : ExitBuf;

{-------------------------------------------------------------------------}

{ Berechnung der K-Werte mit dem Formel-Code }
function Rechne(var Code; x, y : real) : real;

const
  MaxStack = 50;

var
  Pc, Sp : integer;
  Oc     : byte;
  Stack  : array [0..MaxStack] of real;
  OpCode : array [0..MaxInt] of byte absolute Code;

begin
  Pc := 0;
  Sp := 0;
  repeat
    Oc := OpCode[Pc];
    Inc(Pc);
    case Oc of
      0  : begin
             Inc(Sp);
             Stack[Sp] := x;
           end;
      1  : begin
             Inc(Sp);
             Stack[Sp] := y;
           end;
      2  : begin
             Inc(Sp);
             Move(OpCode[Pc], Stack[Sp], SizeOf(real));
             Inc(Pc, SizeOf(real));
           end;
      3  : begin
             Dec(Sp);
             Stack[Sp] := Stack[Sp]+Stack[Succ(Sp)];
           end;
      4  : begin
             Dec(Sp);
             Stack[Sp] := Stack[Sp]-Stack[Succ(Sp)];
           end;
      5  : begin
             Dec(Sp);
             Stack[Sp] := Stack[Sp]*Stack[Succ(Sp)];
           end;
      6  : begin
             Dec(Sp);
             Stack[Sp] := Stack[Sp]/Stack[Succ(Sp)];
           end;
      7  : Stack[Sp] := Sin(Stack[Sp]);
      8  : Stack[Sp] := Cos(Stack[Sp]);
      9  : Stack[Sp] := Sin(Stack[Sp])/Cos(Stack[Sp]);
      10 : Stack[Sp] := ArcTan(Stack[Sp]);
      11 : Stack[Sp] := Exp(Stack[Sp]);
      12 : Stack[Sp] := Ln(Stack[Sp]);
      13 : Stack[Sp] := Ln(Stack[Sp])/Ln(10.0);
      14 : Stack[Sp] := Sqr(Stack[Sp]);
      15 : Stack[Sp] := Sqrt(Stack[Sp]);
      16 : Stack[Sp] := Frac(Stack[Sp]);
      17 : Stack[Sp] := Int(Stack[Sp]);
      18 : Stack[Sp] := Abs(Stack[Sp]);
      19 : Stack[Sp] := -Stack[Sp];
    end;
  until Oc >= 20;
  Rechne := Stack[1];
end; { Rechne }

{-------------------------------------------------------------------------}

{ Erzeugung des Formel-Codes aus der Differential-Gleichung }
procedure Compile(var Ausdruck; var Code; Size : integer;
  Meldung : boolean; var ErrPos, Pc : integer);

type
  RunTime = (LoadVarX, LoadVarY, Push, Add, Sub, Mult, Divi, Sin, Cos,
    Tan, ArcTan, Exp, Ln, Log, Sqr, Sqrt, Frac, Int, Abs, Neg, Stop);
  Str1 = string [1];

const
  FNam : array [Sin..Abs] of string [6] = ('SIN', 'COS', 'TAN', 'ARCTAN',
    'EXP', 'LN', 'LOG', 'SQR', 'SQRT', 'FRAC', 'INT', 'ABS');

var
  Formel     : string [255] absolute Ausdruck;
  OpCode     : array [0..MaxInt] of Runtime absolute Code;
  Chp, Tiefe : integer;
  K, Dummy   : word;
  Ch         : char;

{-------------------------------------------------------------------------}

procedure Fehler(Nr : integer);

var
  i, j : integer;
  R    : TRect;
  Strng, Strng1 : string;

begin
  if Meldung then
  begin
    case Nr of
      0 : Strng1 := 'Speicherplatz im Codefeld reicht nicht';
      1 : Strng1 := 'Operator erwartet';
      2 : Strng1 := '"(" erwartet';
      3 : Strng1 := 'Unbekannte Funktion';
      4 : Strng1 := '")" erwartet';
      5 : Strng1 := 'Konstante, Variable oder Funktion erwartet';
      6 : Strng1 := 'Fehler in Konstante';
      7 : Strng1 := 'Klammer-Fehler'
    end;
    Strng := '';
    for i := 1 to Chp-1 do Strng := Strng + ' ';
    Strng := Strng + '^';
    j := Length(Strng);
    for i := j+1 TO Length(Formel) do Strng := Strng + ' '
  end;
  if ErrPos = 0 then ErrPos := Chp;
  R.Assign(13, 6, 67, 17);
  MessageBoxRect(R, #3+Formel+#13+#3+Strng+#13+#13+#3+Strng1, nil,
    mfError or mfOKButton);
  LongExit(CpuSave, Dummy);
end; { Fehler }

{-------------------------------------------------------------------------}

procedure GetChar;

begin
  repeat
    Inc(Chp);
    if Chp > Length(Formel) then Ch := #0 else Ch := Upcase(Formel[Chp]);
  until Ch <> ' '
end; { GetChar }

{-------------------------------------------------------------------------}

procedure PutCode(B : Runtime);

begin
  if Pc >= Size then Fehler(0) else OpCode[Pc] := B;
  Inc(Pc)
end; { PutCode }

{-------------------------------------------------------------------------}

procedure PutReal(R : real);

begin
  if Pc + SizeOf(real) >= Size then Fehler(0)
    else Move(R, Opcode[Pc], SizeOf(real));
  Inc(Pc,SizeOf(real))
end; { PutReal }

{-------------------------------------------------------------------------}

procedure AddSub; Forward;

{-------------------------------------------------------------------------}

procedure Konstante (var Vorz : Str1);

var
  Fp         : real;
  Err1, Err2 : integer;

begin
  Val(Copy(Formel, Chp, 255)+'?', Fp, Err1);
  Val(Vorz+Copy(Formel, Chp, pred(err1)), fp, Err2);
  if Err2 <> 0 then Fehler(6);
  PutCode(Push);
  PutReal(Fp);
  Chp := Chp + Err1 - 2;
  GetChar;
  if not (Ch in ['-','+','/','*',')',#0]) then Fehler(1)
end; { Konstante }

{-------------------------------------------------------------------------}

procedure Term;

var
  Name : string [6];
  i, S : Runtime;
  Vorz : Str1;

begin
  GetChar;
  if Ch in [#0,')'] then
  begin
    Fehler(5);
    Exit
  end;
  if Ch = '-' then
  begin
    Vorz := '-';
    GetChar
  end
  else Vorz := '';
  if Ch = '(' then
  begin
    Inc(Tiefe);
    AddSub;
    Dec(Tiefe);
    if Ch <> ')' then
    begin
      Fehler(4);
      Exit
    end;
    GetChar
  end
  else
  if Ch in ['0'..'9'] then Konstante(Vorz)
  else
  begin
    Name := '';
    while Ch in ['A'..'Z'] do
    begin
      Name := Name + Ch;
      GetChar
    end;
    if Name = 'X' then PutCode(LoadVarX);
    if Name = 'Y' then PutCode(LoadVarY);
    if (Name <> 'X') and (Name <> 'Y') then
    begin
      S := LoadVarX;
      for i := Sin to Abs do if Name = FNam[i] then S := I;
      S := LoadVarY;
      for i := Sin to Abs do if Name = FNam[i] then S := I;
      if (S <> LoadVarX) or (S <> LoadVarY) then
      begin
        if Ch <> '(' then Fehler(2);
        Dec(Chp);
        Term;
        PutCode(S);
      end
      else Fehler(3);
    end;
    if Vorz = '-' then PutCode(Neg)
  end;
end; { Term }

{-------------------------------------------------------------------------}

procedure MultDiv;

begin
  repeat
    case Ch of
      '*' : begin
              Term;
              PutCode(Mult)
            end;
      '/' : begin
              Term;
              PutCode(Divi)
            end;
    end;
  until not (Ch in ['*', '/']);
end; { MultDiv }

{-------------------------------------------------------------------------}

procedure AddSub;

begin
  Term;
  if ErrPos = 0 then
  repeat
    case Ch of
      '-'      : begin
                   Term;
                   MultDiv;
                   PutCode(Sub)
                 end;
      '+'      : begin
                   Term;
                   MultDiv;
                   PutCode(Add)
                 end;
      '('      : Fehler(1);
      ')'      : begin
                   if Tiefe = 0 then Fehler(7);
                   Exit;
                 end;
      '*', '/' : MultDiv;
      #0       :
      else Fehler(1);
    end;
  until (Ch = #0) or (ErrPos <> 0);
end; { AddSub }

{-------------------------------------------------------------------------}

begin { Compile }
  K := SetExit(CpuSave);
  if K = 0 then
  begin
    Chp := 0;
    Pc := 0;
    ErrPos := 0;
    Tiefe := 0;
    AddSub;
    PutCode(Stop)
  end;
end; { Compile }

{-------------------------------------------------------------------------}

end. { Compil }

{-------------------------------------------------------------------------}

Inhalt   Anfang

Unit Anzeige

 
{-------------------------------------------------------------------------}

{ Initialisierung des Grafik-Bildschirmes und Ausgabe der Grafik }
unit Anzeige;

{-------------------------------------------------------------------------}

interface

uses
  DGLGlob,

  { Turbo Pascal Standard Units }
  Crt, Dos, Graph, GraphApp, MsgBox, Objects;

procedure Grafik;

{-------------------------------------------------------------------------}

implementation

{-------------------------------------------------------------------------}

{ Initialisierung des Grafik-Bildschirmes }
procedure Grafik;

{-------------------------------------------------------------------------}

{ Ausgabe der Grafik }
procedure GrafikAnzeige;

var
  i, j  : integer;
  Strng : string;

begin
  { feste Elemente einfgen }
  Rectangle(0, 0, GetMaxX, GetMaxY);
  Line(0, 459, GetMaxX, 459);
  Line(485, 459, 485, GetMaxY);
  Strng := 'Weiter mit ';
  OutTextXY(500, 466, Strng);

  { Differential-Gleichung ausgeben }
  Strng := 'dy/dx = '+DiffGl;
  OutTextXY(15, 466, Strng);

  { Koordinatenkreuz zeichnen }
  Line(Skala[0], Skala[1], Skala[2], Skala[1]);
  OutTextXY(Skala[2]-20, Skala[1]-10, 'x');
  Line(Skala[3], Skala[4], Skala[3], Skala[5]);
  OutTextXY(Skala[3]-10, Skala[4]+10, 'y');

  { Skalenstriche zeichnen und Skalenbeschriftung }
  i := 19+Skala[6];
  j := 0;
  repeat
    if abs(Skala[3]-i) < 10 then i := Skala[3];
    Line(i, Skala[1]-3, i, Skala[1]+3);
    OutTextXY(i-30, Skala[1]+8, x_Beschriftung[j]);
    i := i+Skala[6];
    inc(j);
  until i > 604;
  i := 439-Skala[7];
  j := 0;
  repeat
    if abs(Skala[1]-i) < 10 then i := Skala[1];
    Line(Skala[3]-3, i, Skala[3]+3, i);
    if Skala[3] < 559 then
      OutTextXY(Skala[3]+8, i-3, y_Beschriftung[j])
    else OutTextXY(Skala[3]-10*length(y_Beschriftung[j])+10, i-3,
      y_Beschriftung[j]);
    i := i-Skala[7];
    inc(j);
  until i < 34;

  { Hilfspunkte zeichnen }
  i := 19;
  repeat
    if abs(Skala[3]-i) < 10 then i := Skala[3];
    j := 439;
    repeat
      if abs(Skala[1]-j) < 10 then j := Skala[1];
      PutPixel(i, j, white);
      PutPixel(619, j, white);
      j := j-Skala[7];
    until j < 34;
    PutPixel(i, 19, white);
    i := i+Skala[6];
  until i > 604;
  PutPixel(619, 19, white);

  { Funktion zeichnen }
  for i := 0 to nd do PutPixel(dw[i].x, dw[i].y, yellow);
end; { GrafikAnzeige }

{-------------------------------------------------------------------------}

var
  BGIPath : PString;
  GraphOk : boolean;
  Taste   : char;

begin { Grafik }
  BGIPath := NewStr(FExpand('.'));
  GraphOk := GraphAppInit(0, 0, BGIPath, true);
  if not GraphOk then
    MessageBox(#3+'Kann Grafiktreiber nicht finden', nil,
      mfOKButton or mfError);
  if GraphicsStart then
  begin
    GrafikAnzeige;
    repeat
      Taste := readkey
    until Taste in [chr(27)]; { Escape-Taste }
    GraphicsStop;
  end;
end; { Grafik }

{-------------------------------------------------------------------------}

end. { Anzeige }

{-------------------------------------------------------------------------}

Inhalt   Anfang

Unit LoadSave

 
{-------------------------------------------------------------------------}

{ Laden und Speichern von Dateien }
unit LoadSave;

{-------------------------------------------------------------------------}

interface

uses
  Anzeige, DGLGlob,

  { Turbo Pascal Standard Units }
  App, Dialogs, MsgBox, Objects, StdDlg, Views;

procedure ParFileRead;
procedure ParFileWrite;
procedure Laden;
procedure Speichern;

{-------------------------------------------------------------------------}

implementation

const
  ParFileName : string = 'DGL.PAR';
  Extens      : string = '*.DGL';

var
  ParamFile, DatFile : text;
  FileName           : string;

{-------------------------------------------------------------------------}

{ Laden der Parameter fr das Eingabefenster }
procedure ParFileRead;

begin
  if Exists(ParFileName) then
  begin
    Assign(ParamFile, ParFileName);
    Reset(ParamFile);
    ReadLn(ParamFile, DiffGl);
    ReadLn(ParamFile, x_min);
    ReadLn(ParamFile, x_max);
    ReadLn(ParamFile, y_anfang);
    ReadLn(ParamFile, e);
    Close(ParamFile)
  end
  else
  begin
    DiffGl := 'cos(x)*y';
    x_min := -8;
    x_max := 0;
    y_anfang := exp(sin(-8));
    e := 0.000000001;
  end;
end; { ParFileRead }

{-------------------------------------------------------------------------}

{ Speichern der Parameter aus dem Eingabefenster }
procedure ParFileWrite;

begin
  Assign(ParamFile, ParFileName);
  ReWrite(ParamFile);
  WriteLn(ParamFile, DiffGl);
  WriteLn(ParamFile, x_min);
  WriteLn(ParamFile, x_max);
  WriteLn(ParamFile, y_anfang);
  WriteLn(ParamFile, e);
  Close(ParamFile);
end; { ParFileWrite }

{-------------------------------------------------------------------------}

{ ™ffnen einer Darstellungs-Datei }
procedure Laden;

{-------------------------------------------------------------------------}

{ Laden der Daten einer Dartellungs_Datei }
procedure DatFileRead;

var
  i : word;

begin
  Assign(DatFile, FileName);
  Reset(DatFile);
  ReadLn(DatFile, DiffGl);
  for i := 0 to 7 do ReadLn(DatFile, Skala[i]);
  ReadLn(Datfile, n_xBeschriftung);
  for i := 0 to n_xBeschriftung do ReadLn(Datfile, x_Beschriftung[i]);
  ReadLn(Datfile, n_yBeschriftung);
  for i := 0 to n_yBeschriftung do ReadLn(Datfile, y_Beschriftung[i]);
  ReadLn(DatFile, nd);
  for i := 0 to nd do
  begin
    ReadLn(DatFile, dw[i].x);
    ReadLn(DatFile, dw[i].y);
  end;
  Close(DatFile);
end; { DatFileRead }

{-------------------------------------------------------------------------}

var
  R       : TRect;
  D       : PFileDialog;
  Command : word;

begin  { Laden }
  repeat
    D := New(PFileDialog, Init(Extens, 'Datei ”ffnen', '~N~ame',
           fdOpenButton, fdReplaceButton));
    Command := Desktop^.ExecView(D);
    if (Command <> cmCancel) then
    begin
      D^.GetFileName(FileName);
      if Exists(FileName) then
      begin
        DatFileRead;
        Grafik;
      end
      else MessageBox(#3+'Datei nicht gefunden'+#13+#13, nil,
             mfError or mfOKButton);
    end;
    Dispose(D, Done);
  until (Command = cmCancel);
end; { Laden }

{-------------------------------------------------------------------------}

{ Abspeichern einer Darstellungs-Datei }
procedure Speichern;

{-------------------------------------------------------------------------}

{ Speichern der Daten einer Darstellungs-Datei }
procedure DatFileWrite;

var
  i : word;

begin
  Assign(DatFile, FileName);
  ReWrite(DatFile);
  WriteLn(DatFile, DiffGl);
  for i := 0 to 7 do WriteLn(DatFile, Skala[i]);
  WriteLn(Datfile, n_xBeschriftung);
  for i := 0 to n_xBeschriftung do WriteLn(Datfile, x_Beschriftung[i]);
  WriteLn(Datfile, n_yBeschriftung);
  for i := 0 to n_yBeschriftung do WriteLn(Datfile, y_Beschriftung[i]);
  WriteLn(DatFile, nd);
  for i := 0 to nd do
  begin
    WriteLn(DatFile, dw[i].x);
    WriteLn(DatFile, dw[i].y);
  end;
  Close(DatFile);
end; { DatFileWrite }

{-------------------------------------------------------------------------}

var
  R      : TRect;
  D      : PFileDialog;

begin { Speichern }
  Ok := false;
  repeat
    D := New(PFileDialog, Init(Extens, 'Datei speichern', '~N~ame',
      fdOkButton, fdReplaceButton));
    if Desktop^.ExecView(D) <> cmCancel then
    begin
      D^.GetFileName(FileName);
      if Exists(FileName) then
      begin
        if MessageBox(#3+'Datei existiert!'+#13+#3+'šberschreiben?',
             nil, mfInformation or mfOkCancel) = cmOk then
        begin
          Assign(DatFile, FileName);
          Erase(DatFile);
          DatFileWrite;
          Ok := true;
        end;
      end
      else DatFileWrite;
      Ok := true
    end
    else Ok:= true;
    Dispose(D, Done);
  until Ok = true;
end; { Speichern }

{-------------------------------------------------------------------------}

end. { LoadSave }

{-------------------------------------------------------------------------}

Inhalt   Anfang

Unit Error

 
{-------------------------------------------------------------------------}

{ Abfangen von Fehlern in der Berechnung }
unit Error;

{$F+}

{-------------------------------------------------------------------------}

interface

type
  ExitBuf = record
    Bp, Cs, Ip : word
  end;

var
  CpuPointer : ExitBuf;
  ErrCode    : word;

function SetExit(var CpuSave : ExitBuf) : word;
procedure LongExit(var CpuSave : ExitBuf; RetV : word);

{-------------------------------------------------------------------------}

implementation

var
  Stack : record
    case boolean of
      true  : (Offset, Segment : word);
      false : (Zeiger : ^word)
    end;
  ExitSave : pointer;

{-------------------------------------------------------------------------}

function SetExit(var CpuSave : ExitBuf) : word;

begin
  with Stack do
  begin
    Zeiger := Ptr(SSeg, SPtr+2);
    CpuSave.bp := Zeiger^;
    Inc(Offset, 2);
    CpuSave.ip := Zeiger^;
    Inc(Offset, 2);
    CpuSave.cs := Zeiger^
  end;
  SetExit := 0
end; { SetExit }

{-------------------------------------------------------------------------}

procedure LongExit(var CpuSave : ExitBuf; RetV : word);

var
  Dummy : word;

begin
  with Stack do
  begin
    Zeiger := Ptr(SSeg, SPtr+2);
    Zeiger^ := CpuSave.bp;
    Inc(Offset, 2);
    Zeiger^ := CpuSave.ip;
    Inc(Offset, 2);
    Zeiger^ := CpuSave.cs;
  end;
  Dummy := RetV
end; { LongExit }

{-------------------------------------------------------------------------}

procedure MyExit;

begin
  ExitProc := ExitSave;
  if ExitCode in [200, 205, 206, 207] then
  begin
    ErrCode := ExitCode;
    ExitCode := 0;
    ErrorAddr := nil;
    ExitProc := @MyExit;
    LongExit(CpuPointer, ErrCode)
  end;
end; { MyExit }

{-------------------------------------------------------------------------}

begin
  ExitSave := ExitProc;
  ExitProc := @MyExit
end. { Error }

{-------------------------------------------------------------------------}

Inhalt   Anfang

Unit Etc

 
{-------------------------------------------------------------------------}

{ zus„tzlichen Programmteile }
unit Etc;

{-------------------------------------------------------------------------}

interface

uses
  DGLGlob,

  { Turbo Pascal Standard Units }
  App, Dialogs, Calc, Objects, Views;

procedure Rechner;
procedure Info;

{-------------------------------------------------------------------------}

implementation

{-------------------------------------------------------------------------}

{ einfacher Taschenrechner aus Turbo Pascal Standard Unit }
procedure Rechner;

var
  P : PCalculator;

begin
  P := New(PCalculator, Init);
  P^.HelpCtx := hcRechner;
  Desktop^.Insert(P);
end; { Rechner }

{-------------------------------------------------------------------------}

{ Programm-Information }
procedure Info;

var
  D : PDialog;
  R : TRect;

begin
  R.Assign(0, 0, 45, 11);
  D := New(PDialog, Init(R,'Info'));
  with D^ do
  begin
    Options := Options or ofCentered;
    R.Grow(-1, -1);
    Dec(R.B.Y, 3);
    Insert(New(PStaticText, Init(R,
      #13+^C'Numerische L”sung von expliziten'#13+
      ^C'Differential-Gleichungen erster Ordnung'#13+
      #13+^C'1996/97'#13+^C'Udo Becker')));
    R.Assign(17, 8, 27, 10);
    Insert(New(PButton, Init(R, '~O~K', cmOk, bfDefault)));
  end;
  Desktop^.ExecView(D);
  Dispose(D, Done);
end; { Info }

{-------------------------------------------------------------------------}

end. { Etc }

{-------------------------------------------------------------------------}

Inhalt   Anfang

Dateien der Programmdiskette

Auf der Programmdiskette befinden sich folgende Dateien:

Hauptverzeichnis \:

DGL.EXE Programm DGL
DGL.PAR Parameter-Datei
EGAVGA.BGI Borland Graphic Interface
BEISP1.DGL Beispieldatei
BEISP2A.DGL Beispieldatei
BEISP2B.DGL Beispieldatei
BEISP2C.DGL Beispieldatei

Unterverzeichnis \SOURCE:

DGL.PAS Hauptprogramm
DGLGLOB.PAS Globale Deklarationen
INPUT.PAS Eingaberoutine
RECHNUNG.PAS Berechnungen
COMPIL.PAS Berechnungshilfen
ANZEIGE.PAS Grafische Ausgabe
LOADSAVE.PAS Laden und Speichern
ERROR.PAS Fehlerbehandlung
ETC.PAS zusätzliche Programmteile

Inhalt   Anfang

Zurück

13. August 2000, Udo Becker