home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 04 / quellen / readstr.inc < prev    next >
Encoding:
Text File  |  1979-12-31  |  5.9 KB  |  157 lines
  1. (**************************************************************************)
  2. (*                                                                        *)
  3. (*               READSTR.INC  -  Editieren von String-Eingaben            *)
  4. (*                                                                        *)
  5. (*                           ---  Vers  1.0  ---                          *)
  6. (*                                                                        *)
  7. (**************************************************************************)
  8.  
  9. PROCEDURE ReadStr (VAR s: strg; xpos, ypos, MaxLen: INTEGER; Prompt: Strg);
  10.  
  11.                                                   (* ASCII-Steuerzeichen: *)
  12.    CONST LEFT   = ^S;           (* Cursor links    : CONTRL-S             *)
  13.          RIGTH  = ^D;           (* Cursor rechts   : CONTRL-D             *)
  14.          WORDL  = ^A;           (* Cursor zum Anfang des letzten Wortes   *)
  15.          WORDR  = ^F;           (* Cursor zum Anfang des naechsten Worts  *)
  16.          CLEAR  = ^G;           (* Zeichen unter Cursor loeschen          *)
  17.          DEL    = #127;         (* Zeichen links von Cursor loeschen      *)
  18.          CLRWRD = ^T;           (* loescht das Wort rechts vom Cursor     *)
  19.          CLRALL = ^Y;           (* gesamte Eingabezeile loeschen          *)
  20.          RETURN = ^M;           (* Abschluss der Zeile                    *)
  21.          PREFIX = ^Q;           (* Prefix fuer die folgenden Kommandos:   *)
  22.          BEGINP = ^S;           (* Cursor an Anfang der Eingabezeile      *)
  23.          ENDINP = ^D;           (* Cursor ans Ende der Eingabezeile       *)
  24.          CLREST = ^Y;           (* Eingabezeile ab Cursor loeschen        *)
  25.  
  26.          Letters: SET OF CHAR = ['0'..'9','A'..'Z','a'..'z'];
  27.  
  28.    VAR   x, y, i, j, p, Len: INTEGER;
  29.          Inpt              : strg;
  30.          Key,
  31.          ErasedChar        : CHAR;
  32.          EndOfInpt,
  33.          WriteFlag,
  34.          ClearFlag         : BOOLEAN;
  35.  
  36. BEGIN
  37.   GotoXY(xpos, ypos); Write (Prompt);
  38.   xpos := xpos + Pred(Length(Prompt));
  39.   x := xpos;
  40.   y := ypos;
  41.   p := 1;                                  (* Cusor-Position im Srtring   *)
  42.   Len := 0;                                (* aktuelle Laenge des Strings *)
  43.   Inpt := '';
  44.   EndofInpt := FALSE;
  45.   IF NOT (MaxLen IN [0..255]) THEN MaxLen := 0;
  46.   Write(' ':maxlen); Gotoxy(succ(x),y);
  47.   REPEAT
  48.     WriteFlag := FALSE;
  49.     ClearFlag := FALSE;
  50.     REPEAT UNTIL KeyPressed;               (* auf Tastendruck warten      *)
  51.     Read (Kbd, Key);                       (* und Zeichen ohne Eche lesen *)
  52.     CASE Key OF
  53.         LEFT: IF p >= 2 THEN p := Pred(p);
  54.        RIGTH: IF p <= Len THEN p := Succ(p);
  55.        WORDL: BEGIN
  56.                 IF p <> 1 THEN
  57.                   IF NOT (Inpt[p-1] IN Letters) THEN
  58.                     WHILE NOT (Inpt[p-1] IN Letters) AND (p > 1) DO
  59.                       p := Pred(p);
  60.                 WHILE (Inpt[p-1] IN Letters) AND (p > 1) DO
  61.                   p := Pred(p);
  62.               END;
  63.        WORDR: BEGIN
  64.                 WHILE (Inpt[p] IN Letters) AND (p <= Len) DO
  65.                   p := Succ(p);
  66.                 WHILE NOT (Inpt[p] IN Letters) AND (p <= Len) DO
  67.                   p := Succ(p);
  68.               END;
  69.        CLEAR: IF p <> Succ(Len) THEN
  70.               BEGIN
  71.                 ClearFlag := TRUE;
  72.                 WriteFlag := TRUE;
  73.                 Delete(Inpt, p, 1);
  74.                 Len := Pred(Len);
  75.               END;
  76.       CLRWRD: BEGIN
  77.                 j :=0;
  78.                 IF Len > 0 THEN
  79.                 REPEAT
  80.                   ErasedChar := Inpt[p];
  81.                   Delete(Inpt,p,1);
  82.                   Len := Pred(Len);
  83.                   j := Succ(j);
  84.                 UNTIL NOT (Inpt[p] IN Letters) OR
  85.                       NOT (ErasedChar IN Letters) OR (p > Len);
  86.                 Write(Copy(Inpt, p, Len-p+1));
  87.                 FOR i := 1 TO j DO Write(' ');
  88.                 GotoXY(x+p, y);
  89.               END;
  90.          DEL: IF p >= 2 THEN
  91.               BEGIN
  92.                 ClearFlag := TRUE;
  93.                 WriteFlag := TRUE;
  94.                 Delete(Inpt, p-1, 1);
  95.                 Len := Pred(Len);
  96.                 p := Pred(p);
  97.               END;
  98.       CLRALL: BEGIN
  99.                 x := xpos;
  100.                 y := ypos;
  101.                 p := 1;
  102.                 GotoXY(x+p, y);
  103.                 FOR i := 1 TO Len DO Write (' ');
  104.                 Len := 0;
  105.                 Inpt := '';
  106.               END;
  107.       RETURN: EndOfInpt := TRUE;
  108.       PREFIX: BEGIN
  109.                 REPEAT UNTIL KeyPressed;
  110.                 Read (Kbd, Key);
  111.                 CASE Key OF
  112.                   CLREST: BEGIN
  113.                             FOR i := p TO Len DO Write (' ');
  114.                             Len := Pred(p);
  115.                             Inpt := Copy(Inpt, 1, Pred(p));
  116.                           END;
  117.                   BEGINP: BEGIN
  118.                             x := xpos;
  119.                             y := ypos;
  120.                             p := 1
  121.                           END;
  122.                   ENDINP: p := Succ (Len)
  123.                 END;
  124.               END;
  125.       ELSE
  126.         IF (Key >= ' ') AND (Len < MaxLen) THEN
  127.         BEGIN
  128.           Inpt := Copy(Inpt, 1, p-1) + Key + Copy(Inpt, p, Len);
  129.           Write(Key);
  130.           IF p <> Succ(Len) THEN WriteFlag := TRUE;
  131.           Len := Succ(Len);
  132.           p := Succ(p);
  133.         END;
  134.     END;
  135.     WHILE x+p > 80 DO
  136.     BEGIN
  137.       x := x - 80;
  138.       y := Succ(y);
  139.     END;
  140.     WHILE x+p < 1 DO
  141.     BEGIN
  142.       x := x + 80;
  143.       y := Pred (y);
  144.     END;
  145.     IF WriteFlag THEN
  146.     BEGIN
  147.       GotoXY(x+p, y);
  148.       Write(Copy(Inpt, p, Len-p+1));
  149.     END;
  150.     IF ClearFlag THEN Write (' ');
  151.     GotoXY(x+p, y);
  152.   UNTIL EndOfInpt;
  153.   s := Inpt;
  154. END;
  155.  
  156. (*------------------------------------------------------------------------*)
  157.