home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / readstr.inc < prev    next >
Text File  |  1987-02-03  |  6KB  |  156 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.   REPEAT
  47.     WriteFlag := FALSE;
  48.     ClearFlag := FALSE;
  49.     REPEAT UNTIL KeyPressed;               (* auf Tastendruck warten      *)
  50.     Read (Kbd, Key);                       (* und Zeichen ohne Eche lesen *)
  51.     CASE Key OF
  52.         LEFT: IF p >= 2 THEN p := Pred(p);
  53.        RIGTH: IF p <= Len THEN p := Succ(p);
  54.        WORDL: BEGIN
  55.                 IF p <> 1 THEN
  56.                   IF NOT (Inpt[p-1] IN Letters) THEN
  57.                     WHILE NOT (Inpt[p-1] IN Letters) AND (p > 1) DO
  58.                       p := Pred(p);
  59.                 WHILE (Inpt[p-1] IN Letters) AND (p > 1) DO
  60.                   p := Pred(p);
  61.               END;
  62.        WORDR: BEGIN
  63.                 WHILE (Inpt[p] IN Letters) AND (p <= Len) DO
  64.                   p := Succ(p);
  65.                 WHILE NOT (Inpt[p] IN Letters) AND (p <= Len) DO
  66.                   p := Succ(p);
  67.               END;
  68.        CLEAR: IF p <> Succ(Len) THEN
  69.               BEGIN
  70.                 ClearFlag := TRUE;
  71.                 WriteFlag := TRUE;
  72.                 Delete(Inpt, p, 1);
  73.                 Len := Pred(Len);
  74.               END;
  75.       CLRWRD: BEGIN
  76.                 j :=0;
  77.                 IF Len > 0 THEN
  78.                 REPEAT
  79.                   ErasedChar := Inpt[p];
  80.                   Delete(Inpt,p,1);
  81.                   Len := Pred(Len);
  82.                   j := Succ(j);
  83.                 UNTIL NOT (Inpt[p] IN Letters) OR
  84.                       NOT (ErasedChar IN Letters) OR (p > Len);
  85.                 Write(Copy(Inpt, p, Len-p+1));
  86.                 FOR i := 1 TO j DO Write(' ');
  87.                 GotoXY(x+p, y);
  88.               END;
  89.          DEL: IF p >= 2 THEN
  90.               BEGIN
  91.                 ClearFlag := TRUE;
  92.                 WriteFlag := TRUE;
  93.                 Delete(Inpt, p-1, 1);
  94.                 Len := Pred(Len);
  95.                 p := Pred(p);
  96.               END;
  97.       CLRALL: BEGIN
  98.                 x := xpos;
  99.                 y := ypos;
  100.                 p := 1;
  101.                 GotoXY(x+p, y);
  102.                 FOR i := 1 TO Len DO Write (' ');
  103.                 Len := 0;
  104.                 Inpt := '';
  105.               END;
  106.       RETURN: EndOfInpt := TRUE;
  107.       PREFIX: BEGIN
  108.                 REPEAT UNTIL KeyPressed;
  109.                 Read (Kbd, Key);
  110.                 CASE Key OF
  111.                   CLREST: BEGIN
  112.                             FOR i := p TO Len DO Write (' ');
  113.                             Len := Pred(p);
  114.                             Inpt := Copy(Inpt, 1, Pred(p));
  115.                           END;
  116.                   BEGINP: BEGIN
  117.                             x := xpos;
  118.                             y := ypos;
  119.                             p := 1
  120.                           END;
  121.                   ENDINP: p := Succ (Len)
  122.                 END;
  123.               END;
  124.       ELSE
  125.         IF (Key >= ' ') AND (Len < MaxLen) THEN
  126.         BEGIN
  127.           Inpt := Copy(Inpt, 1, p-1) + Key + Copy(Inpt, p, Len);
  128.           Write(Key);
  129.           IF p <> Succ(Len) THEN WriteFlag := TRUE;
  130.           Len := Succ(Len);
  131.           p := Succ(p);
  132.         END;
  133.     END;
  134.     WHILE x+p > 80 DO
  135.     BEGIN
  136.       x := x - 80;
  137.       y := Succ(y);
  138.     END;
  139.     WHILE x+p < 1 DO
  140.     BEGIN
  141.       x := x + 80;
  142.       y := Pred (y);
  143.     END;
  144.     IF WriteFlag THEN
  145.     BEGIN
  146.       GotoXY(x+p, y);
  147.       Write(Copy(Inpt, p, Len-p+1));
  148.     END;
  149.     IF ClearFlag THEN Write (' ');
  150.     GotoXY(x+p, y);
  151.   UNTIL EndOfInpt;
  152.   s := Inpt;
  153. END;
  154.  
  155. (*------------------------------------------------------------------------*)
  156.