home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / files / fileman / fm / fminput.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  7.1 KB  |  216 lines
  1. {
  2. --------------------------------------------------------------------------
  3.                        F i l e    I n f o r m a t i o n
  4.  
  5. * DESCRIPTION
  6. File used with FM.PAS.
  7.  
  8. * ASSOCIATED FILES
  9. FM.PAS
  10. FM.DOC
  11. FM.EXE
  12. FM.TPU
  13. FMFILE.PAS
  14. FMINPUT.PAS
  15. FMSCREEN.PAS
  16. FMUTEST.EXE
  17. FMUTEST.PAS
  18. FMVIEW.PAS
  19.  
  20. ==========================================================================
  21. }
  22. {$R-}   { Range checking off }                         { Unit:    FMInput.PAS }
  23. {$S-}   { Stack checking off }                         { Program: FM.PAS      }
  24. {$V+}   { Strict String parameter checking on }        { Author:  Jim Zwick   }
  25. {$I-}   { I/O checking off }                           { Version: 1.0         }
  26. {$B-}   { Boolean short-circuit evaluation on }        { Date:    03-04-88    }
  27.  
  28. UNIT FMInput;
  29.  
  30. INTERFACE
  31.  
  32. USES
  33.   Crt,
  34.   FMScreen;
  35.  
  36.  
  37. TYPE
  38.   Str80 = STRING[80];
  39.  
  40. CONST
  41.   Up     = #200;
  42.   Down   = #208;
  43.   PgUp   = #201;
  44.   PgDn   = #209;
  45.   Home   = #199;
  46.   EndKey = #207;
  47.   Left   = #203;
  48.   Right  = #205;
  49.   F1     = #187;
  50.  
  51.  
  52.   FUNCTION PadR(St : Str80; Ch : CHAR; FW: BYTE) : Str80;
  53.   FUNCTION GetKey(KeyList : Str80; UpperCase : BOOLEAN) : CHAR;
  54.   PROCEDURE ReadStr(X, Y, Len : BYTE; VAR S : Str80);
  55.   PROCEDURE WritePrompt(X, Y : BYTE; Msg : Str80);
  56.  
  57.  
  58. IMPLEMENTATION
  59.  
  60.   FUNCTION PadR(St : Str80; Ch : CHAR; FW: BYTE) : Str80;
  61.   VAR
  62.     TS : Str80;
  63.   BEGIN
  64.     IF (LENGTH(St) >= FW) THEN PadR := COPY(St, 1, FW)         { Reduce to FW }
  65.     ELSE
  66.       BEGIN
  67.         FILLCHAR(TS, SIZEOF(TS), Ch);             { Pad St with Ch to fill FW }
  68.         TS[0] := CHR(FW - LENGTH(St));
  69.         PadR := St + TS;
  70.       END;
  71.   END;
  72.   { ------------------------------------------------------------------------- }
  73.  
  74.   FUNCTION GetKey(KeyList : Str80; UpperCase : BOOLEAN) : CHAR;
  75.   VAR
  76.     Ch, Ch2 : CHAR;            { Retrieves keystroke, converts to upper case }
  77.   BEGIN                        { if requested, converts extended scan codes  }
  78.     REPEAT                     { by adding 128 so they can be interpreted by }
  79.       KbdStatus;               { single IF or CASE statements                }
  80.       Ch := ReadKey;
  81.       IF UpperCase THEN Ch := UPCASE(Ch);
  82.       GetKey := Ch;
  83.       IF (Ch = #0) AND KEYPRESSED THEN
  84.         BEGIN
  85.           Ch2 := ReadKey;
  86.           IF (ORD(Ch2) < 128) THEN Ch2 := CHR(ORD(Ch2) + 128);
  87.           GetKey := Ch2;
  88.         END;
  89.       IF (LENGTH(KeyList) = 0) THEN EXIT;
  90.     UNTIL POS(Ch, KeyList) > 0;
  91.   END;
  92.   { ------------------------------------------------------------------------- }
  93.  
  94.   PROCEDURE ReadFld(X, Y, Len : BYTE; St : Str80; VAR OutStr : Str80);
  95.   CONST
  96.     BS        = ^H;       { Line editor with implementation of many standard  }
  97.     BackSp    = #8;       { editing functions.  Others can be easily added    }
  98.     CR        = #13;      { by expanding options in CASE statement.  It       }
  99.     Esc       = #27;      { returns OutStr from position 1 to cursor position }
  100.     CtrlLeft  = #243;
  101.     CtrlRight = #244;
  102.     CtrlEnd   = #245;
  103.     DelKey    = #211;
  104.  
  105.   VAR
  106.     P, TempP : INTEGER;
  107.     Ch       : CHAR;
  108.     EndLine  : BOOLEAN;
  109.  
  110.     { ------------------ }
  111.  
  112.   BEGIN
  113.     P := 1;
  114.     EndLine := FALSE;
  115.     GotoXY(X, Y);    WRITE(St);
  116.     REPEAT
  117.       St := PadR(St, '_', Len);    { Maintains marked field width be adding }
  118.       GotoXY(X+P-1, Y);            { directly to work string, then returns  }
  119.       CursorOn(TRUE);              { OutStr only to cursor position         }
  120.       Ch := GetKey('', TRUE);
  121.       CursorOn(FALSE);
  122.       CASE Ch OF
  123.         #32..#126 : IF (P <= Len) THEN
  124.                       BEGIN
  125.                         IF (InsKeyOn) THEN                           { Insert }
  126.                           BEGIN
  127.                             DELETE(St, Len, 1);
  128.                             INSERT(Ch, St, P);
  129.                             WRITE(COPY(St, P, Len));
  130.                           END
  131.                         ELSE
  132.                           BEGIN
  133.                             WRITE(Ch);                            { Overwrite }
  134.                             St[P] := Ch;
  135.                           END;
  136.                         Inc(P);
  137.                       END;
  138.         CR : EndLine := TRUE;
  139.         Home : P := 1;
  140.         EndKey : BEGIN
  141.                    P := Len;
  142.                    WHILE (St[P] = '_') AND (P > 1) DO Dec(P);
  143.                    IF (St[P] <> '_') THEN Inc(P);
  144.                  END;
  145.         Left : IF (P > 1) THEN Dec(P);
  146.         Right : IF (P <= Len) THEN Inc(P);
  147.      CtrlLeft : BEGIN                                    { Move left one word }
  148.                   WHILE (P > 1) AND (St[P-1] = '_') DO Dec(P);
  149.                   WHILE (P > 1) AND (St[P-1] = ' ') DO Dec(P);
  150.                   WHILE (P > 1) AND (St[P-1] <> ' ') DO Dec(P);
  151.                 END;
  152.     CtrlRight : BEGIN                                   { Move right one word }
  153.                   WHILE (P <= Len) AND (St[P-1] = ' ') DO Inc(P);
  154.                   WHILE (P <= Len) AND (St[P-1] <> ' ') DO Inc(P);
  155.                   WHILE (P > 1) AND (St[P-1] = '_') DO Dec(P);
  156.                 END;
  157.        BackSp : IF (P > 1) THEN
  158.                   BEGIN
  159.                     Dec(P);
  160.                     DELETE(St, P, 1);
  161.                     WRITE(BS, COPY(St, P, Len), '_');
  162.                   END;
  163.         DelKey : IF (P >= 1) THEN
  164.                    BEGIN
  165.                      DELETE(St, P, 1);
  166.                      WRITE(COPY(St, P, Len), '_');
  167.                    END;
  168.         Esc : BEGIN
  169.                 St := '';
  170.                 IF (P = 1) THEN EndLine := TRUE       { If cursor at start of }
  171.                 ELSE                                  { field then exit, ELSE }
  172.                   BEGIN                               { delete field and move }
  173.                     GotoXY(X, Y);                     { cursor to start of    }
  174.                     WRITE(PadR(St, '_', Len));        { field                 }
  175.                     P := 1;
  176.                   END;
  177.               END;
  178.         CtrlEnd : BEGIN                  { Delete from cursor to end of field }
  179.                     St := PadR(COPY(St, 1, P - 1), '_', Len);
  180.                     GotoXY(X, Y);
  181.                     WRITE(St);
  182.                   END;
  183.       END;
  184.     UNTIL EndLine;
  185.     CursorOn(TRUE);
  186.     OutStr := COPY(St, 1, P-1)
  187.   END;
  188.   { ------------------------------------------------------------------------- }
  189.  
  190.   PROCEDURE ReadStr(X, Y, Len : BYTE; VAR S : Str80);
  191.   VAR
  192.     NewStr : Str80;       { Reads string with ReadFld, returns changed String }
  193.   BEGIN                   { only if NULL string not returned from ReadFld     }
  194.     NewStr[0] := #0;
  195.     ReadFld(X, Y, Len, PadR(S, '_', Len), NewStr);
  196.     IF NewStr[0] <> #0 THEN S := NewStr;
  197.     GotoXY(X, Y);
  198.     WRITE(PadR(S, ' ', Len));
  199.   END;
  200.   { ------------------------------------------------------------------------- }
  201.  
  202.   PROCEDURE WritePrompt(X, Y : BYTE; Msg : Str80);
  203.   VAR
  204.     Reply : CHAR;
  205.   BEGIN
  206.     HIGHVIDEO;
  207.     ClrLn(X, Y);    WRITE(Msg, ' -- Press Any Key');
  208.     LOWVIDEO;
  209.     Reply := GetKey('', FALSE);
  210.     ClrLn(X, Y);
  211.   END;
  212.   { ------------------------------------------------------------------------- }
  213.  
  214. END.
  215. 
  216.