home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / toolkid / getline.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1980-01-01  |  5.0 KB  |  134 lines
  1. UNIT GETLINE;
  2.  
  3. INTERFACE
  4.  USES IOSTUFF,CRT;
  5.  FUNCTION GetStr(X,Y,Len:Integer;Default:AnyStr) : AnyStr;
  6.  
  7. IMPLEMENTATION
  8.  
  9. CONST
  10.   LeftArrow  = #75;         { Keys used in editing string }
  11.   RightArrow = #77;
  12.   InsertKey  = #82;
  13.   DeleteKey  = #83;
  14.   EnterKey   = #13;
  15.   EscKey     = #27;
  16.   BackSpKey  = #8;
  17.   CtrlBackSp = #127;
  18.   HomeKey    = #71;
  19.   EndKey     = #79;
  20.  
  21. VAR
  22.   II,JJ     : Integer;
  23.   InsToggle : Boolean;     { Insert key toggle switch }
  24.   Virgin    : Boolean;     { Used for edit versus enter-new decision }
  25. {======================================================================}
  26. FUNCTION GetStr(X,Y,Len:Integer;Default:AnyStr) : AnyStr;
  27. VAR
  28.    ExitGetStr          : Boolean;  { Exit switch }
  29.    TCh                 : Char;     { Current keystroke }
  30.    XG,II               : Integer;  { Remember starting X position }
  31.    TempStr             : AnyStr;   { Temporary string for editing }
  32.    FunctKey            : Boolean;  { True if keystroke was function key}
  33.  
  34. BEGIN
  35.    ExitGetStr := False;   { Set exit switch false }
  36.    XG := X;
  37.    X := X+Length(Default);            { Set X location of cursor }
  38.    FillChar(TempStr,Sizeof(TempStr),' ');  { Fill TempStr with Blanks }
  39.    Tempstr[0] := Chr(Len);
  40.    WriteSt(TempStr,XG,Y);              { Write blanks on screen }
  41.    InsToggle := False;                  { Start with insert off }
  42.    WriteSt(Default,XG,Y);              { Write default on screen }
  43.    Virgin := true;                      { Assume default will not be edited }
  44.    ShowCursor;                          { Make sure cursor is visible }
  45. Repeat
  46.      If X > XG+Len-1 then Begin        { Increment cursor location }
  47.        X := XG+Len-1;
  48.        Beep;
  49.      End;
  50.      If X < XG then Begin              { Don't let cursor get out of field }
  51.        X := XG;
  52.        Beep;
  53.      End;
  54.  
  55.       GoToXY(X,Y);                    { Position cursor }
  56.  
  57.       If InsToggle then Bigcursor else Linecursor;   { Make cursor big }
  58.  
  59.       TCh := ReadKey;                    { Read a keystroke }
  60.       If TCh <> #0 then FunctKey := False else
  61.       Begin
  62.         FunctKey := True;
  63.         TCh := ReadKey;
  64.       End;
  65.  
  66.   If FunctKey then case TCh of       { Handle function keys here }
  67.       LeftArrow : X := X - 1;      { Decrement cursor location }
  68.       RightArrow: X := X + 1;      { Increment cursor location }
  69.       InsertKey : Begin              { Toggle insert switch on/off}
  70.                    InsToggle := not InsToggle;
  71.                    If InsToggle then Bigcursor  {block cursor - ins off}
  72.                    Else Linecursor;             {line cursor - ins on}
  73.                   End;
  74.       DeleteKey : Begin             {delete - destruct Char at cursor}
  75.                    TempStr:= ReadFromScr(X+1,Y,XG+Len-X-1);
  76.                    WriteSt(TempStr,X,Y);
  77.                    Write(' ');
  78.                   End;
  79.       HomeKey   : X := XG;          { Cursor to begining of string }
  80.       EndKey    : X := XG+Len-1;    { Cursor to end of string }
  81.  
  82.    End;  {Function key true}
  83.  
  84.   If not FunctKey then case TCh of    {  Handle non function keys }
  85.       #28..#126,
  86.       #128..#255 : Begin              { Regular everyday Characters}
  87.                     If Virgin then Begin   { If virgin then delete default }
  88.                        FillChar(TempStr,Sizeof(TempStr),' ');
  89.                        Tempstr[0] := Chr(Len);
  90.                        WriteSt(TempStr,XG,Y);
  91.                        X := XG;
  92.                        GoToXY(X,Y);
  93.                      End;
  94.                     If InsToggle then Begin  { If insert then push characters }
  95.                       TempStr := ReadFromScr(X,Y,XG+Len-X-1);
  96.                       WriteSt(TempStr,X+1,Y);
  97.                       GoToXY(X,Y);
  98.                      End;
  99.                     Write(TCh);        { Finally write the character on screen }
  100.                     X := X+1;
  101.                   End;
  102.        EnterKey : Begin                   { Get set to exit }
  103.                    ExitGetStr := true;
  104.                   End;
  105.        EscKey   : Begin                   { Exit now with a nul string }
  106.                    GetStr := '';
  107.                    Exit;
  108.                   End;
  109.        BackSpKey :Begin                  { Destruct Char to left }
  110.                    If X > XG then Begin
  111.                      TempStr := ReadFromScr(X,Y,XG+Len-X);
  112.                      WriteSt(TempStr,X-1,Y);
  113.                      Write(' ');
  114.                    End;
  115.                      X := X-1;
  116.                   End;
  117.        CtrlBackSp :Begin                { Delete entire string }
  118.                      FillChar(TempStr,Sizeof(TempStr),' ');
  119.                      Tempstr[0] := Chr(Len);
  120.                      WriteSt(TempStr,XG,Y);
  121.                      X := XG;
  122.                    End;
  123.  
  124.    End; { FunctKey false}
  125.  Virgin := false;        { Set virgin false if any editing key hit }
  126. Until ExitGetStr;
  127.  
  128.    Linecursor;                         { Reset the cursor }
  129.    GetStr := ReadFromScr(XG,Y,Len);   { Read the edited string from screen }
  130.  
  131.  
  132. END;
  133.  
  134. END.  {UNIT}