home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / strings.pas < prev    next >
Pascal/Delphi Source File  |  1986-10-12  |  20KB  |  616 lines
  1. (*---------------------------------------------------------------------------*)
  2. (*                        Strings in Standard-Pascal
  3.                          ----------------------------
  4.   Implementation des String-Types als ein ARRAY [0..max] OF CHAR.
  5.   Implementiert sind folgende Prozeduren/Funktionen:
  6.     AssignStr, Length, ReadStr, ReadLnStr, WriteStr, WriteLnStr, Concat,
  7.     Copy, Pos, Delete, Insert, Val, Str.
  8.   Zur Fehlerbehandlung
  9.   Bei allen werden ev. moegliche Laengenueberschreitungen abgefangen und
  10.   fuehren zu keiner Fehlermeldung (z.B. Index-Bereich)
  11.  
  12.   String-Struktur: Index = 0 : n, Laenge des Strings (0<n<256)
  13.                            1 : 1. Zeichen
  14.                            .
  15.                            .
  16.                            n : n. Zeichen
  17.                           n+1: ungenutzt
  18.                            .
  19.                            .
  20.                           max: ungenutzt
  21.  
  22.   Folgende Deklarationen muessen im Haupt-Programm an entsprechender Stelle
  23.   vorgenommen werden:                                                        *)
  24.  
  25.  
  26. CONST
  27.      (* max. moegliche Laenge des String-Types; ist den Beduerfnissen im
  28.         Haupt-Programm entsprechend anzupassen (s. String-Struktur):     *)
  29.  
  30.       StMaxLen = 255;
  31.  
  32.      (* Laenge von Zeichenketten-Parametern (PACKED ARRAY OF CHAR) der
  33.         Prozedur 'AssignStr'; ist ebenfalls entsprechend anzupassen.     *)
  34.  
  35.       StrParLen = 25;
  36.  
  37.      (* Schalter zur Unterdrueckung von Laufzeitfehlern bei der String-
  38.         Verarbeitung. Ist 'StErrFg'=TRUE, werden Fehler unterdrueckt,
  39.         in dem z.B. Zeichen abgeschnitten werden. Andernfalls muesste
  40.         das Laufzeitsystem 'Index ausserhalb des zulaessigen Bereichs'
  41.         melden. Der 'StErrFg' behandelnde Quell-Code kann, um z.B. weniger
  42.         Objekt-Code zu erhalten, ganz entfallen (generelle Fehlermeldung)
  43.         oder zur generellen Fehlerbehandlung modifiziert werden. Der je-
  44.         weilige Code zur Fehlerbehandlung ist mit 'StErrBeg' und
  45.         'StErrEnd' gekennzeichnet.                                       *)
  46.  
  47.      StErrFg = FALSE;
  48.  
  49. TYPE
  50.      (* Der String-Typ:                   *)
  51.  
  52.      String = ARRAY [0..StMaxLen] OF CHAR;
  53.  
  54.      (* Der 'String-Parameter-Typ':       *)
  55.  
  56.      StrPar = PACKED ARRAY [1..StrParLen] OF CHAR;
  57.  
  58. (*---------------------------------------------------------------------------*)
  59. (* Zuweisung von 'Num' Zeichen der Zeichenkette 'PAChar' an den String 'St'.
  60.    'PAChar' darf hoechstens 'StrParLen' Zeichen enthalten. Enthaelt die zu-
  61.    zuweisende Zeichenkette weniger Zeichen, muessen die restlichen Stellen
  62.    bis 'StrParLen' aufgefuellt werden.
  63.    Bsp.: Annahme: 'StrParLen = 8'
  64.          'AssignStr(stvar,'Halloxxx',5)' weist der String-Variablen 'stvar'
  65.          die Zeichenkette 'Hallo' zu.                                        *)
  66.  
  67. PROCEDURE AssignStr (VAR St: String; PAChar: StrPar; Num: INTEGER);
  68.  
  69. VAR i: INTEGER;
  70.  
  71. BEGIN
  72.   (* StErrBeg *)
  73.   IF StErrFg THEN
  74.     IF Num > StMaxLen THEN                       (* Anzahl der zuzuweisenden *)
  75.       Num := StMaxLen                            (* Zeichen korrigieren.     *)
  76.     ELSE IF Num < 1 THEN
  77.       Num := 1;
  78.   (* StErrEnd *)
  79.   FOR i := 1 TO Num DO
  80.     St[i] := PAChar[i];
  81.   St[0] := Chr(Num);
  82. END;
  83.  
  84. (*---------------------------------------------------------------------------*)
  85. (* Ermitteln der aktuellen Laenge des Strings 'St':                          *)
  86.  
  87. FUNCTION Length (VAR St: String): INTEGER;
  88.  
  89. BEGIN
  90.   Length := Ord(St[0]);
  91. END;
  92.  
  93. (*---------------------------------------------------------------------------*)
  94. (* Zeichen aus der Datei 'InFile' lesen und dem String 'St' zuweisen. Dabei
  95.    werden fuehrende Leerzeichen ueberlesen und die Zuweisung beendet, wenn
  96.    wieder ein Leerzeichen oder Eingabeende auftritt.
  97.    Bsp.: 'ReadStr(Input, stvar)' liest die Zeichenkette 'Hallo' in die
  98.          Stringvar. 'stvar' bei folgender Eingabe:
  99.                  Hallo Welt <CR>
  100.          Ein zweites 'ReadStr' wuerde dann 'Welt' in 'stvar' einlesen.
  101.    ACHTUNG:
  102.    Als Editierfunktion fuer Tastatureingabe ist hier nur die Backspace-
  103.    Taste vorgesehen. Der in der Konstanten 'bs' definierte Wert ist an den
  104.    Code der entspr. Taste des benutzten Rechners anzupassen!                 *)
  105.  
  106. PROCEDURE ReadStr (VAR InFile: TEXT; VAR St: String);
  107.  
  108. CONST bs = 8;                (* ASCII-Code der Backspace-Taste, hier 8(dez.) *)
  109.  
  110. VAR ch: CHAR;
  111.     i,
  112.     StErrLen: INTEGER;                    (* Hilfsvar. fuer Fehlerbehandlung *)
  113.  
  114. BEGIN
  115.   (* StErrBeg *)
  116.   IF StErrFg THEN
  117.     StErrLen := StMaxLen
  118.   ELSE
  119.     StErrLen := Succ(StMaxLen);
  120.   (* StErrEnd *)
  121.   i := 0;
  122.   REPEAT
  123.     Read(InFile, ch);
  124.   UNTIL ch <> ' ';
  125.   WHILE (NOT(Eoln(InFile))) AND (ch <> ' ')
  126.   (* StErrBeg : je nach Modus ist 'StErrLen' passend zum Typ 'String' oder
  127.                 zu gross -> Fehlerabbruch                                    *)
  128.   AND (i < StErrLen)
  129.   (* StErrEnd *)
  130.   DO
  131.   BEGIN
  132.     IF (Ord(ch) = bs) AND (i > 0) THEN
  133.       i := Pred(i)
  134.     ELSE
  135.     BEGIN
  136.       i := Succ(i);
  137.       St[i] := ch;
  138.     END;
  139.     Read(InFile, ch);
  140.   END;
  141.   St[0] := Chr(i);
  142. END;
  143.  
  144. (*---------------------------------------------------------------------------*)
  145. (* Zeichen aus der Datei 'InFile' lesen und dem String 'St' zuweisen bis
  146.    Eingabeende 'Eoln'. Es werden  a l l e  Zeichen in 'St' gespeichert bis
  147.    auf Backspace und 'Eoln' (s. ReadStr).                                    *)
  148.  
  149. PROCEDURE ReadLnStr (VAR InFile: TEXT; VAR St: String);
  150.  
  151. CONST bs = 8;
  152.  
  153. VAR ch: CHAR;
  154.     i,
  155.     StErrLen : INTEGER;                                      (* s. 'ReadStr' *)
  156.  
  157. BEGIN
  158.   (* StErrBeg *)
  159.   IF StErrFg THEN
  160.     StErrLen := StMaxLen
  161.   ELSE
  162.     StErrLen := Succ(StMaxLen);
  163.   (* StErrEnd *)
  164.   i := 0;
  165.   Read(InFile, ch);
  166.   WHILE NOT(Eoln(InFile))
  167.   (* StErrBeg : s. 'ReadStr' *)
  168.   AND (i < StErrLen)
  169.   (* StErrEnd *)
  170.   DO
  171.   BEGIN
  172.     IF (Ord(ch) = bs) AND (i > 0) THEN
  173.       i := Pred(i)
  174.     ELSE
  175.     BEGIN
  176.       i := Succ(i);
  177.       St[i] := ch;
  178.     END;
  179.     Read(InFile, ch);
  180.   END;
  181.   St[0] := Chr(i);
  182. END;
  183.  
  184. (*---------------------------------------------------------------------------*)
  185. (* String 'St' in die Datei 'OutFile' ausgeben.                              *)
  186.  
  187. PROCEDURE WriteStr (VAR OutFile: TEXT; VAR St: String);
  188.  
  189. VAR i: INTEGER;
  190.  
  191. BEGIN
  192.   FOR i := 1 TO Ord(St[0]) DO
  193.     Write(OutFile, St[i])
  194. END;
  195.  
  196. (*---------------------------------------------------------------------------*)
  197. (* Wie WriteStr, jedoch mit CR/LF.                                           *)
  198.  
  199. PROCEDURE WriteLnStr (VAR OutFile: TEXT; VAR St: String);
  200.  
  201. BEGIN
  202.   WriteStr(OutFile, St);
  203.   WriteLn(OutFile);
  204. END;
  205.  
  206. (*---------------------------------------------------------------------------*)
  207. (* Den String 'St2' an den String 'St1' anhaengen und das Ergebnis in 'Dest'
  208.    ausgeben.                                                                 *)
  209.  
  210. PROCEDURE Concat (VAR Dest, St1, St2: String);
  211.  
  212. VAR i, len1, geslen: INTEGER;
  213.  
  214. BEGIN
  215.   len1 := Ord(St1[0]);
  216.   geslen := len1+Ord(St2[0]);
  217.   (* StErrBeg *)
  218.   IF StErrFg AND (geslen > StMaxLen) THEN
  219.     geslen := StMaxLen                                      (* Abschneiden ? *)
  220.   ELSE IF NOT(StErrFg) AND (geslen > STMaxLen) THEN
  221.     geslen := Succ(StMaxLen);
  222.   (* StErrEnd *)
  223.   Dest := St1;
  224.   FOR i := Succ(len1) TO geslen DO
  225.     Dest[i] := St2[i-len1];
  226.   Dest[0] := Chr(geslen)
  227. END;
  228.  
  229. (*---------------------------------------------------------------------------*)
  230. (* Einen Teilstring aus 'St' ab der Position 'Pos' mit 'Num' Zeichen in den
  231.    String 'Dest' kopieren. Ist 'Pos' groesser als die Laenge von 'St', ent-
  232.    steht ein leerer Teilstring. Ist 'Num' zu gross, werden nur die in 'St'
  233.    ab 'Pos' vorraetigen Zeichen kopiert!                                     *)
  234.  
  235. PROCEDURE Copy (VAR Dest, St: String; Pos, Num: integer);
  236.  
  237. VAR i, n, len: INTEGER;
  238.  
  239. BEGIN
  240.   Dest[0] := Chr(0);
  241.   len := Ord(St[0]);
  242.   IF Pos <= len THEN
  243.   BEGIN
  244.     (* StErrBeg *)
  245.     IF StErrFg AND (Pos < 1) THEN
  246.       Pos := 1;
  247.     (* StErrEnd *)
  248.     Num := Pred(Num);
  249.     IF Pos+Num > len THEN
  250.       Num := len-Pos;
  251.     i := 1;
  252.     FOR n := Pos TO Pos+Num DO
  253.     BEGIN
  254.       Dest[i] := St[n];
  255.       i := Succ(i);
  256.     END;
  257.     Dest[0] := Chr(Succ(Num));
  258.   END;
  259. END;
  260.  
  261. (*---------------------------------------------------------------------------*)
  262. (* Der Teilstring 'Part' wird ab der Position 'Start' im String 'Main' ge-
  263.    sucht. Wird er nicht in 'Main' gefunden, liefert die Funktion den Wert 0,
  264.    sonst die Position des 1. Zeichens von 'Part', die der Teilstring in
  265.    'Main' innehat.                                                           *)
  266.  
  267. FUNCTION Pos (Start: INTEGER; VAR Part, Main: String): INTEGER;
  268.  
  269. VAR p, lenp, lenm, stop: INTEGER;
  270.     found: BOOLEAN;
  271.  
  272. BEGIN
  273.   found := FALSE;
  274.   Pos := 0;
  275.   lenm := Ord(Main[0]);
  276.   lenp := Ord(Part[0]);
  277.   (* StErrBeg *)
  278.   IF StErrFg THEN
  279.     IF Start < 1 THEN
  280.       Start := 1
  281.     ELSE IF Start > StMaxLen THEN
  282.       Start := StMaxLen;
  283.   (* StErrEnd *)
  284.   stop := Succ(lenm-lenp);
  285.   IF Start <= stop THEN
  286.     REPEAT
  287.       p := 1;
  288.       WHILE (p <= lenp) AND (Part[p] = Main[Pred(Start+p)]) DO
  289.         p := Succ(p);
  290.       IF p < lenp THEN
  291.         Start := Succ(Start)
  292.       ELSE
  293.         found := TRUE;
  294.     UNTIL (Start > stop) OR found;
  295.   IF found THEN
  296.     Pos := Start;
  297. END;
  298.  
  299. (*---------------------------------------------------------------------------*)
  300. (* Aus dem String 'St' ab der Position 'Pos' 'Num' zeichen loeschen. Die Zei-
  301.    chen hinter 'Pos'+'Num'-1 ruecken auf, falls vorhanden.                   *)
  302.  
  303. PROCEDURE Delete (VAR St: String; Pos, Num: INTEGER);
  304.  
  305. VAR i, len: INTEGER;
  306.  
  307. BEGIN
  308.   (* StErrBeg *)
  309.   IF StErrFg THEN
  310.     IF Pos > StMaxLen THEN
  311.       Pos := StMaxLen
  312.     ELSE IF Pos < 1 THEN
  313.       Pos := 1;
  314.   (* StErrEnd *)
  315.   len := Ord(St[0]);
  316.   IF Pos <= len THEN
  317.   BEGIN
  318.     IF Pred(Pos+Num) > len THEN
  319.       Num := Succ(len-Pos);
  320.     FOR i := Pos+Num TO len DO
  321.       St[i-Num] := St[i];
  322.     St[0] := Chr(len-Num);
  323.   END;
  324. END;
  325.  
  326. (*---------------------------------------------------------------------------*)
  327. (* Den String 'St' an Position 'Pos' in den String 'Dest' einfuegen. Ist
  328.    'Pos' groesser als Length(Dest), wird 'St' angefuegt. Ist die neue Laenge
  329.    groesser als 'StMaxLen', werden die ueberzaehligen Zeichen abgeschnitten. *)
  330.  
  331. PROCEDURE Insert (St: String; VAR Dest: String; Pos: INTEGER);
  332.  
  333. VAR rest: String;
  334.      len: INTEGER;
  335.  
  336. BEGIN
  337.   (* StErrBeg *)
  338.   IF StErrFg THEN
  339.     IF Pos < 1 THEN
  340.       Pos := 1
  341.     ELSE IF Pos > StMaxLen THEN
  342.       Pos := StMaxLen;
  343.   (* StErrEnd *)
  344.   len := Ord(Dest[0]);
  345.   IF Pos > len THEN
  346.     Pos := Succ(len);
  347.   Copy(rest, Dest, Pos, Succ(len-Pos));
  348.   Delete(Dest, Pos, len);
  349.   FOR len := 1 TO 2 DO
  350.   BEGIN
  351.     IF Ord(Dest[0])+Ord(St[0]) > StMaxLen THEN
  352.       St[0] := Chr(StMaxLen-Ord(Dest[0]));
  353.     Concat(Dest, Dest, St);
  354.     St := rest;
  355.   END;
  356. END;
  357.  
  358. (*---------------------------------------------------------------------------*)
  359. (* Den String 'St' in den REAL-Wert 'Rvar' umwandeln. Dabei werden fuehrende
  360.    Leerzeichen ueberlesen, die Umwandlung beim Auftreten eines nicht zur Zahl
  361.    gehoerenden Zeichens abgebrochen. Konnte keine Zahl erkannt werden, wird
  362.    in 'Code' die Position in 'St' zurueckgegeben, an der die Umwandlung abge-
  363.    brochen wurde und 'Rvar' ist undefiniert. Andernfalls erhaelt 'Code' den
  364.    Wert 0 und 'Rvar' den entspr. REAL-Wert.
  365.    Bsp.: '  1.5'=1.5  '-.3333'=-0.3333  ' +1E10'=1.0E10  ' 2.1e-4'=2.1E-4
  366.          ' 40xy'=40.0 ' a123 '=???????  '10+300'=10.0                        *)
  367.  
  368. PROCEDURE Val (VAR St: String; VAR Rvar: REAL; VAR Code: INTEGER);
  369.  
  370. VAR p, len, eval: INTEGER;
  371.     mval, ds    : REAL;
  372.     neg         : BOOLEAN;
  373.  
  374.   (* Ganzzahlige Zeichenkette in REAL-Wert wandeln.                          *)
  375.   FUNCTION IntVal : REAL;
  376.  
  377.   VAR ival : REAL;
  378.  
  379.   BEGIN
  380.     ival := 0;
  381.     neg := FALSE;
  382.     IF (St[p] IN ['+','-']) AND (p <= len) THEN
  383.     BEGIN
  384.       neg := St[p] = '-';                                       (* negativ ? *)
  385.       p := Succ(p);
  386.     END;
  387.     WHILE (St[p] IN ['0'..'9']) AND (p <= len) DO
  388.     BEGIN
  389.       ival := ival*10+Ord(St[p])-Ord('0');
  390.       p := Succ(p);
  391.     END;
  392.     IntVal := ival;
  393.   END;
  394.  
  395.  
  396. BEGIN
  397.   Code := 1;
  398.   IF Ord(St[0]) > 0 THEN
  399.   BEGIN
  400.     len := Ord(St[0]);
  401.     p := 1;
  402.     WHILE (St[p] = ' ') AND (p <= len) DO         (* Leerzeichen ueberlesen. *)
  403.       p := Succ (p);
  404.     IF St[p] IN ['0'..'9','+','-','.'] THEN
  405.     BEGIN
  406.       Code := 0;
  407.       mval := IntVal;                      (* ganzzahligen Anteil umwandeln. *)
  408.       IF (St[p] = '.') AND (p <= len) THEN        (* Dezimalteil vorhanden ? *)
  409.       BEGIN
  410.         p := Succ(p);
  411.         ds := 10;
  412.         WHILE (St[p] IN ['0'..'9']) AND (p <= len) DO
  413.         BEGIN
  414.           mval := mval+(Ord(St[p])-Ord('0'))/ds;
  415.           ds := ds*10;
  416.           p := Succ(p);
  417.         END;
  418.       END;
  419.       IF neg THEN
  420.         mval := -mval;
  421.       IF (St[p] IN ['E','e']) AND (p <= len) THEN
  422.       BEGIN
  423.         p := Succ(p);
  424.         eval := TRUNC(IntVal);
  425.         IF neg THEN
  426.           FOR p := 1 TO eval DO        (* Iteration: Grund s. Str-Funktion ! *)
  427.             mval := mval/10
  428.         ELSE
  429.           FOR p := 1 TO eval DO
  430.             mval := mval*10;
  431.       END;
  432.     END
  433.     ELSE
  434.       Code := p;
  435.   END;
  436.   Rvar := mval;
  437. END;
  438.  
  439. (*---------------------------------------------------------------------------*)
  440. (* Den numerischen Wert 'Value' in den String 'St' umwandeln.
  441.    'n' gibt die Anzahl der 'Zeichenstellen' an, die die Zahl als String haben
  442.    soll. Ist 'n'=0 wird die Exponential-Darstellung gewaehlt und 'AnzSig'
  443.    Mantissenstellen ausgegeben ('AnzSig '= Mantissenstellen der Implementa-
  444.    tion - 1). 'm' gibt bei 'n'<>0 die Anzahl der Nachkommastellen an (s.a.
  445.    Write).                                                                   *)
  446.  
  447. PROCEDURE Str (Value: REAL; n, m: INTEGER; VAR St: String);
  448.  
  449. CONST AnzSig = 10;                              (* sig. Mantissenstellen - 1 *)
  450.       Fehler = 1.0E-10;     (* Fehlergrenze fuer Vergleiche und Korrektur bei
  451.                                Subtraktion.                                  *)
  452.  
  453. VAR p, exex, tmp: INTEGER;
  454.     ex: REAL;                   (* muss REAL sein, wg. Aufruf von 'StrPart'. *)
  455.  
  456.   (* Fuer die Normalisierung auf eine Vorkommastelle wurde folg. iteratives
  457.      Verfahren gewaehlt, da 'ex:=Trunc(ln(Value)/ln(10))' und 'Value:=
  458.      Value/Exp(ex*ln(10))' bei der zum Test verwendeten Implementation, die
  459.      n i c h t  mit BCD-Arithmetik arbeitet, zu Fehlern fuehrte!
  460.      (z.B. bei Value=100)                                                    *)
  461.  
  462.   FUNCTION exponent (VAR Value: REAL): INTEGER;
  463.  
  464.   VAR mp: REAL;
  465.       ex: INTEGER;
  466.  
  467.   BEGIN
  468.     ex := 0;
  469.     IF Value <> 0.0 THEN
  470.       WHILE Value+Fehler < 1.0 DO
  471.       BEGIN
  472.         Value := Value*10.0;
  473.         ex := Pred(ex);
  474.       END;
  475.     WHILE Value >= 10.0 DO
  476.     BEGIN
  477.       Value := Value/10.0;
  478.       ex := Succ(ex);
  479.     END;
  480.     exponent := ex;
  481.   END;
  482.  
  483.   (* Auch lieferte die 'Trunc'-Funktion in bestimmten Faellen ein falsches
  484.      Ergebnis, so dass die Vorkommastelle auf folgende, umstaendlich er-
  485.      scheinende, aber funktionierente Weise ermittelt wird.                  *)
  486.  
  487.   Function MyTrunc (Value: REAL): INTEGER;
  488.  
  489.   BEGIN
  490.     IF Value+Fehler < 1.0 THEN
  491.       MyTrunc := 0
  492.     ELSE IF Value+Fehler < 2.0 THEN
  493.       MyTrunc := 1
  494.     ELSE IF Value+Fehler < 3.0 THEN
  495.       MyTrunc := 2
  496.     ELSE IF Value+Fehler < 4.0 THEN
  497.       MyTrunc := 3
  498.     ELSE IF Value+Fehler < 5.0 THEN
  499.       MyTrunc := 4
  500.     ELSE IF Value+Fehler < 6.0 THEN
  501.       MyTrunc := 5
  502.     ELSE IF Value+Fehler < 7.0 THEN
  503.       MyTrunc := 6
  504.     ELSE IF Value+Fehler < 8.0 THEN
  505.       MyTrunc := 7
  506.     ELSE IF Value+Fehler < 9.0 THEN
  507.       MyTrunc := 8
  508.     ELSE IF Value+Fehler < 10.0 THEN
  509.       MyTrunc := 9;
  510.   END;
  511.  
  512.   (* Hier werden 'digits' Stellen des REAL-Wertes in eine Zeichenkette umge-
  513.      wandelt! Da die Subtraktion die 'gefaehrlichste' numerische Operation
  514.      ist, musste - um Fehler zu vermeiden - auch hier eine Vorsichtsmass-
  515.      nahme her (s.u.)                                                        *)
  516.  
  517.   PROCEDURE StrPart (VAR Value: REAL; digits: INTEGER; VAR St: String);
  518.  
  519.   VAR i, j, ch: INTEGER;
  520.       tmpval: REAL;
  521.  
  522.   BEGIN
  523.     FOR i := 1 TO digits DO
  524.     BEGIN
  525.       ch := MyTrunc(Value);
  526.       St[p] := Chr(ch+Ord('0'));
  527.       p := Succ(p);
  528.       Value := Value-ch+Fehler*0.1;                         (* VORSICHT !!!! *)
  529.       Value := Value*10;
  530.     END;
  531.   END;
  532.  
  533.  
  534. BEGIN
  535.   p := 1;
  536.   IF Value < 0 THEN                                        (* Wert negativ ? *)
  537.   BEGIN
  538.     St[1] := '-';
  539.     p := Succ(p);
  540.   END;
  541.   Value := Abs(Value);
  542.   ex := exponent(Value);                            (* Wert 'normalisieren'. *)
  543.   IF n <> 0 THEN                  (* keine Exponential-Darstellung, ist dass *)
  544.   BEGIN                           (*  mit angegebener Stellenzahl moeglich ? *)
  545.     tmp := Succ(Trunc(ex));     (* Wieviel Vorkommastellen sind auszugeben ? *)
  546.     IF St[1] = '-' THEN              (* Vorzeichen bei neg. Zahlen beruecks. *)
  547.       tmp := Succ(tmp);
  548.     IF m <> 0 THEN                         (* Nachkommastellen gewuenscht,   *)
  549.       tmp := Succ(tmp);                    (* Dezimalpunkt beruecksichtigen. *)
  550.     IF tmp > n-m THEN              (* passt nicht, Exp.-Darstellung nehmen ! *)
  551.       n := 0;
  552.   END;
  553.   IF n = 0 THEN                     (* Exponential-Darstellung ist gewaehlt! *)
  554.   BEGIN
  555.     StrPart(Value,1,St);                        (* Vorkommastelle umwandeln. *)
  556.     St[p] := '.';
  557.     p := Succ(p);
  558.     StrPart(Value,AnzSig,St);       (* soviel Nachkommastellen, wie Implemen-
  559.                                        tation erlaubt, umwandeln.            *)
  560.     IF ex <> 0 THEN                                 (* Exponent darstellen ? *)
  561.     BEGIN
  562.       St[p] := 'E';
  563.       p := succ(p);
  564.       IF ex < 0 THEN                                   (* Exponent negativ ? *)
  565.       BEGIN
  566.         St[p] := '-';
  567.         p := Succ(p);
  568.       END;
  569.       ex := Abs(ex);
  570.       exex := exponent(ex);                      (* Exponent 'normalisieren' *)
  571.       StrPart(ex,Succ(exex),St);                 (* und umwandeln.           *)
  572.     END;
  573.   END
  574.   ELSE                           (* Umwandlung in Vor- und Nachkommastellen! *)
  575.   BEGIN
  576.     StrPart(Value,Succ(Trunc(ex)),St);         (* Vorkommastellen umwandeln. *)
  577.     IF m > 0 THEN                                      (* Nachkommastellen ? *)
  578.     BEGIN
  579.       St[p] := '.';
  580.       p := Succ(p);
  581.       StrPart(Value,m,St);
  582.     END;
  583.   END;
  584.   St[0] := Chr(Pred(p));
  585. END;
  586.  
  587. (*---------------------------------------------------------------------------*)
  588. (* Den String 'St1' mit dem String 'St2' vergleichen. Ist 'St1' kleiner als
  589.    'St2', ist das Ergebnis -1. Ist 'St1' groesser 'St2', ist das Ergebnis 1.
  590.    Sind beide gleich, wird der Wert 0 geliefert.                             *)
  591.  
  592. FUNCTION Compare(Var St1, St2 : String): integer;
  593.  
  594. VAR i: INTEGER;
  595.  
  596. BEGIN
  597.   IF St1[0] < St2[0] THEN
  598.     Compare := -1
  599.   ELSE IF St1[0] > St2[0] THEN
  600.     Compare := +1
  601.   ELSE
  602.   BEGIN
  603.     i := 1;
  604.     WHILE (St1[i] = St2[i]) AND (i <= Ord(St1[0])) DO
  605.       i := Succ(i);
  606.     IF i > Ord(St1[0]) THEN
  607.       Compare := 0
  608.     ELSE IF St1[i] < St2[i] THEN
  609.       Compare := -1
  610.     ELSE
  611.       Compare := +1;
  612.   END;
  613. END;
  614.  
  615. (*---------------------------------------------------------------------------*)
  616.