home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TTT405.ZIP / READTTT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-07-17  |  5.7 KB  |  181 lines
  1. {$S-,R-,V-,D-,T-}
  2. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  3. {         TechnoJocks Turbo Toolkit v4.05           Released: Jul 18, 1988    }
  4. {                                                                             }
  5. {         Module: ReadTTT  --  single line input proc with full editing       }
  6. {                                                                             }
  7. {                  Copyright R. D. Ainsbury (c) 1986-88                       }
  8. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  9.  
  10. Unit ReadTTT;
  11.  
  12. Interface
  13.  
  14. Uses CRT,FastTTT;
  15.  
  16. Procedure ReadLine(X,Y,L,F,B:byte;
  17.                      var Text   :string;
  18.                      var Retcode:integer);
  19.  
  20.  
  21. Implementation
  22.  
  23. Procedure ReadLine(X,Y,L,F,B:byte;
  24.                      var Text   :string;
  25.                      var Retcode:integer);
  26. Const
  27.     CursorRight = #205;
  28.     CursorLeft  = #203;
  29.     EnterKey    = #13;
  30.     EscKey      = #27;
  31.     EndKey      = #207;
  32.     HomeKey     = #199;
  33.     DelKey      = #211;
  34.     Backspace   = #8;
  35.     InsKey      = #210;
  36.  
  37. var
  38.     TempText : string;
  39.     CursorPos : byte;
  40.     InsertMode,
  41.     Alldone : boolean;
  42.     Ch : char;
  43.  
  44.     Procedure Check_Parameters;
  45.     begin
  46.         TempText := Text;
  47.         If length(TempText) > L then
  48.            Delete(Temptext,L+1,length(TempText)-L);
  49.         If not X in [1..80] then
  50.            X := 1;
  51.         If X + L - 1 > 80 then X := 81 - L;
  52.         If not Y in [1..25] then
  53.            Y := 1;
  54.         If length(TempText) < L then
  55.            CursorPos := length(TempText) + 1
  56.         else
  57.            CursorPos := length(TempText);
  58.         Retcode := 0;
  59.         InsertMode  := False;
  60.         Alldone := False;
  61.     end;  {sub Proc Check_Parameters}
  62.  
  63.     Function Underline(Str:string):string;
  64.     var I : integer;
  65.     begin
  66.         while length(Str) < L do
  67.               Str := Str + '_';
  68.         Underline := Str;
  69.     end; {sub Func Underline}
  70.  
  71.     Procedure MoveTheCursor;
  72.     begin
  73.         GotoXY(X+CursorPos-1,Y);
  74.     end;  {sub Proc MoveTheCursor}
  75.  
  76.     Procedure Write_String;
  77.     begin
  78.         Fastwrite(X,Y,attr(F,B),Underline(TempText));
  79.         MoveTheCursor;
  80.     end;
  81.  
  82.     Procedure Erase_Field;
  83.     begin
  84.         TempText := '';
  85.         CursorPos := 1;
  86.         Write_String;
  87.     end;
  88.  
  89.     Procedure Char_Backspace;
  90.     begin
  91.         If CursorPos > 1 then
  92.         begin
  93.             CursorPos := Pred(CursorPos);
  94.             Delete(TempText,CursorPos,1);
  95.             Write_String;
  96.        end;
  97.     end;   {sub Proc Char_Backspace}
  98.  
  99.     Procedure Char_Del;
  100.     begin
  101.         If CursorPos <= length(TempText) then
  102.         begin
  103.             Delete(TempText,CursorPos,1);
  104.             Write_String;
  105.         end;
  106.     end;   {sub Proc Char_Del}
  107.  
  108.  
  109. begin                  {main Procedure IO1Line}
  110.     Check_Parameters;
  111.     Write_String;
  112.     Repeat
  113.          Ch:= Readkey;
  114.          If (Ch = #0) and keypressed then
  115.          begin
  116.              Ch := readkey;
  117.              Ch := chr(ord(Ch) + 128);
  118.          end;
  119.          Case upcase(Ch) of
  120.          CursorRight   :  begin
  121.                               If (CursorPos < L)
  122.                               and (CursorPos <= length(TempText)) then
  123.                               begin
  124.                                   CursorPos := Succ(CursorPos);
  125.                                   MoveTheCursor;
  126.                               end;
  127.                           end;
  128.          CursorLeft    :  begin
  129.                               If CursorPos > 1 then
  130.                               begin
  131.                                   CursorPos := Pred(CursorPos);
  132.                                   MoveTheCursor;
  133.                               end;
  134.                           end;
  135.          HomeKey       :  begin
  136.                               CursorPos := 1;
  137.                               MoveTheCursor;
  138.                           end;
  139.          EndKey        :  begin
  140.                               If CursorPos < L then
  141.                               If length(TempText) < L then
  142.                                   CursorPos := length(TempText) + 1
  143.                               else
  144.                                   CursorPos := L;
  145.                               MoveTheCursor;
  146.                           end;
  147.         InsKey        :  InsertMode := not InsertMode;
  148.         DelKey        :  Char_Del;
  149.         BackSpace     :  Char_Backspace;
  150.         EscKey        :  begin
  151.                              Alldone := true;
  152.                              Retcode := 1;
  153.                          end;
  154.         EnterKey      :  begin
  155.                              Alldone := true;
  156.                              Text := TempText;
  157.                          end;
  158.        #32 .. #126    :  begin
  159.                              If InsertMode then
  160.                              begin
  161.                                  If length(TempText) < L then
  162.                                  begin
  163.                                      Insert(Ch,TempText,CursorPos);
  164.                                      If CursorPos < L then
  165.                                         CursorPos := Succ(CursorPos);
  166.                                  end;
  167.                              end
  168.                              else {not insertmode}
  169.                              begin
  170.                                  Delete(TempText,CursorPos,1);
  171.                                  Insert(Ch,TempText,CursorPos);
  172.                                  If CursorPos < L then
  173.                                     CursorPos := Succ(CursorPos);
  174.                              end;   {if insert}
  175.                              Write_String;
  176.                           end;
  177.       end; {case}
  178.       Until Alldone;
  179. end;  {Proc Read_Line}
  180.  
  181. end.