Turbo Toolbox/Turbo_Toolbox.iso/1991/03/leser/input.pas

Pascal/Delphi Source File | 1990-12-11 | 5.8 KB | 230 lines

(* ------------------------------------------------------ *)
(*                       INPUT.PAS                        *)
(*     Komfortable Stringeingabe mit Editierfunktionen    *)
(*                (c) 1990 Marcel Kreuter                 *)
(* Update 11.12.90: Fixed Bug in Procedure Is_Delete (ga) *)
(* ------------------------------------------------------ *)
UNIT Input;                   { txKeys }

INTERFACE

USES Crt, Dos;

TYPE
  CharSet = SET OF CHAR;

VAR
  InsMode : BOOLEAN;

  FUNCTION ReadStr(zeichen       : CharSet;
                   laenge, platz : BYTE) : STRING;
    { ReadStr wartet auf eine Tastatureingabe und liefert }
    { dann das Ergebnis in Form eines Strings zurück      }

IMPLEMENTATION

  FUNCTION ReadStr(zeichen       : CharSet;
                   laenge, platz : BYTE) : STRING;
  VAR
    ch                       : CHAR;
    s                        : STRING;
    z, n, x, anfang, zanfang : INTEGER;

    PROCEDURE WritePart(l : Byte);
       { WritePart schreibt den gerade aktuellen Teil des }
       { Strings in den vorbestimmten Bildschirmbereich   }
    BEGIN
      WHILE (l <= Length(s)) AND
            (WhereX < anfang + platz) DO BEGIN
        Write(s[l]);
        Inc(l);
      END;
    END;

    PROCEDURE Is_Escape;
    BEGIN
      ReadStr := #27;
    END;

    PROCEDURE Is_Enter;
    BEGIN
      IF Length(s) = 0 THEN ReadStr := ^M;
    END;

    PROCEDURE Is_Backspace;
    BEGIN
      x := WhereX;
      IF (Length(s) > 0) AND (z > 1) THEN BEGIN
        Dec(z);
        Delete(s, z, 1);
        IF (zanfang > 1) AND
           (Length(s) < zanfang + platz) THEN BEGIN
          Dec(zanfang);
          GotoXY(anfang, WhereY);
          WritePart(zanfang);
        END ELSE BEGIN
          GotoXY(anfang, WhereY);
          WritePart(zanfang);
          IF Length(s) < zanfang + platz THEN Write(' ');
          Dec(x);
        END;
      END;
      GotoXY(x, WhereY);
    END;

    PROCEDURE Is_Home;
    BEGIN
      zanfang := 1;
      z       := 1;
      GotoXY(anfang, WhereY);
      WritePart(zanfang);
      GotoXY(anfang, WhereY);
    END;

    PROCEDURE Is_CursorLeft;
    BEGIN
      IF z <= Length(s) THEN BEGIN
        IF (WhereX + 1 = anfang + platz) AND
           (z < Length(s)) THEN BEGIN
          x := WhereX;
          Inc(zanfang);
          GotoXY(anfang, WhereY);
          WritePart(zanfang);
          GotoXY(x, WhereY);
        END ELSE
          GotoXY(WhereX+1, WhereY);
        Inc(z);
      END ELSE
        ch := #254;
    END;

    PROCEDURE Is_CursorRight;
    BEGIN
      IF z > 1 THEN BEGIN
        IF (zanfang > 1) AND (WhereX = anfang) THEN BEGIN
          x := WhereX;
          Dec(zanfang);
          WritePart(zanfang);
          GotoXY(x, WhereY);
        END ELSE
          GotoXY(WhereX-1, WhereY);
        Dec(z)
      END ELSE
        ch := #254;
    END;

    PROCEDURE Is_End;
    BEGIN
      zanfang := Length(s) - platz + 1;
      z       := Length(s) + 1;
      GotoXY(anfang, WhereY);
      WritePart(Length(s) - platz + 1);
      GotoXY(anfang + platz, WhereY);
    END;

    PROCEDURE Is_Insert;
    BEGIN
      InsMode := NOT InsMode;
    END;

    PROCEDURE Is_Delete;
    VAR
      n : BYTE;
    BEGIN
      x := WhereX;
      Delete(s, z, 1);
      IF Length(s) > platz THEN BEGIN
        WritePart(z);
        IF length(s) < zanfang + platz - 1 THEN Write(' ');
      END ELSE BEGIN
        FOR n := z TO Length(s) DO
          Write(s[n]);
        IF Length(s) + 1 < zanfang + platz THEN Write(' ');
      END;
      GotoXY(x, WhereY);
    END;

    PROCEDURE Is_Zeichen;
    BEGIN
      IF InsMode AND (Length(s) < laenge) THEN BEGIN
        x := WhereX;
        Insert(ch, s, z);
        IF (z < Length(s)) OR
           (WhereX = anfang + platz) THEN BEGIN
          IF (WhereX = anfang + platz) OR
             ((WhereX + 1 = anfang + platz) AND
             (z < Length(s))) THEN
            Inc(zanfang)
          ELSE
            Inc(x);
          GotoXY(anfang, WhereY);
          WritePart(zanfang);
        END ELSE BEGIN
          Write(ch);
          Inc(x);
        END;
        GotoXY(x, WhereY);
        Inc(z);
      END ELSE IF NOT InsMode THEN BEGIN
        x := WhereX;
        IF z <= Length(s) THEN BEGIN
          s[z] := ch;
          IF WhereX + 1 = anfang + platz THEN BEGIN
            Inc(zanfang);
            GotoXY(anfang, WhereY);
            WritePart(zanfang);
          END ELSE BEGIN
            Write(ch);
            Inc(x);
          END;
        END ELSE IF (z > Length(s)) AND
                    (Length(s) < laenge) THEN BEGIN
          s := s + ch;
          IF WhereX = anfang + platz THEN BEGIN
            Inc(zanfang);
            GotoXY(anfang, WhereY);
            WritePart(zanfang);
          END ELSE BEGIN
            Write(ch);
            Inc(x);
          END;
        END;
        GotoXY(x, WhereY);
        IF z <= laenge THEN Inc(z);
      END;
    END;

  BEGIN
    s       := '';
    z       := 1;
    zanfang := 1;
    anfang  := WhereX;
    REPEAT
      ch := ReadKey;
      CASE ch OF
        #27 : Is_Escape;
        #13 : Is_Enter;
        #08 : Is_Backspace;
        #00 : BEGIN
                ch := ReadKey;
                CASE ch OF
                  #71 : Is_Home;
                  #77 : Is_CursorLeft;
                  #75 : Is_CursorRight;
                  #79 : Is_End;
                  #82 : Is_Insert;
                  #83 : Is_Delete;
                END;
              END
      ELSE
        IF ch IN zeichen THEN Is_Zeichen;
      END;
    UNTIL ch = #13;
    ReadStr := s;
  END;

BEGIN
  InsMode := TRUE;   { Standardvorgabe }
END.
(* ----------------------------------------------------- *)
(*                  Ende von INPUT.PAS                   *)