home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DESIGN.ZIP / EDITLN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-23  |  4.5 KB  |  167 lines
  1. unit EditLn;
  2. interface
  3. uses CRT,
  4.      MiscTool;
  5. { If a compiler error occurs here, you need to unpack the source
  6.   to the MiscTool unit from the archived file Tools.arc.  See the
  7.   README file on disk 1 for detailed instructions. }
  8.  
  9.  
  10. const
  11.   NULL = #0;
  12.   BS = #8;
  13.   LF = #10;
  14.   CR = #13;
  15.   ESC = #27;
  16.   Space = #32;
  17.   Tab = ^I;
  18.  
  19.   { The following constants are based on the scheme used by the scan key
  20.     function to convert a two key scan code sequence into one character
  21.     by adding 128 to the ordinal value of the second character.
  22.   }
  23.   F1 = #187;
  24.   F2 = #188;
  25.   F3 = #189;
  26.   F4 = #190;
  27.   F5 = #191;
  28.   F6 = #192;
  29.   F7 = #193;
  30.   F8 = #194;
  31.   F9 = #195;
  32.   F10 = #196;
  33.   UpKey = #200;
  34.   DownKey = #208;
  35.   LeftKey = #203;
  36.   RightKey = #205;
  37.   PgUpKey = #201;
  38.   PgDnKey = #209;
  39.   HomeKey = #199;
  40.   EndKey = #207;
  41.   InsKey = #210;
  42.   DelKey = #211;
  43.  
  44. type
  45.   CharSet = set of char;
  46.  
  47. procedure EditLine(var S     : String;
  48.                        Len, X, Y : byte;
  49.                        LegalChars,
  50.                        Term  : CharSet;
  51.                    var TC    : Char    );
  52. {  EditLn implements a line editor that supports WordStar commands
  53.    as well as left-right arrow keys , Home, End, back space, etc.
  54.    Paramaters:
  55.      S : String to be edited
  56.      Len : Maximum characters allowed to be edited
  57.      X, Y : Starting x an y cordinates
  58.      LegalChars : Set of characters that will be accepted
  59.      Term : Set of characters that will cause EditLine to Exit
  60.             (Note LegalChars need not contain Term)
  61.      TC : Character that caused EditLn to exit
  62. }
  63.  
  64. function ScanKey : char;
  65. { Reads a key from the keyboard and converts 2 scan code escape
  66.   sequences into 1 character. }
  67.  
  68. implementation
  69. {$V-}
  70.  
  71. function ScanKey : char;
  72. { Reads a key from the keyboard and converts 2 scan code escape
  73.   sequences into 1 character. }
  74.  
  75. var
  76.   Ch : Char;
  77. begin
  78.   Ch := ReadKey;
  79.   if (Ch = #0) and KeyPressed then
  80.   begin
  81.     Ch := ReadKey;
  82.     if ord(Ch) < 128 then
  83.       Ch := Chr(Ord(Ch) + 128);
  84.   end;
  85.   if Ch = ^C then
  86.     Abort('Program terminated by user');
  87.   ScanKey := Ch;
  88. end; { ScanKey }
  89.  
  90. procedure EditLine(var S : String;
  91.                    Len, X, Y : byte;
  92.                    LegalChars, Term  : CharSet;
  93.                    var TC    : Char);
  94. {  EditLn implements a line editor that supports WordStar commands
  95.    as well as left-right arrow keys , Home, End, back space, etc.
  96.    Paramaters:
  97.      S : String to be edited
  98.      Len : Maximum characters allowed to be edited
  99.      X, Y : Starting x an y cordinates
  100.      LegalChars : Set of characters that will be accepted
  101.      Term : Set of characters that will cause EditLine to Exit
  102.             (Note LegalChars need not contain Term)
  103.      TC : Character that caused EditLn to exit
  104. }
  105.  
  106. var
  107.   P : byte;
  108.   Ch : Char;
  109.   first : boolean;
  110.  
  111. begin
  112.   first := true;
  113.   GotoXY(X,Y); Write(S);
  114.   P := 0;
  115.   repeat
  116.     GotoXY(X + P,Y);
  117.     Ch := ScanKey;
  118.     if not (Upcase(Ch) in Term) then
  119.       case Ch of
  120.         #32..#126 : if (P < Len) and
  121.                        (ch in LegalChars) then
  122.                     begin
  123.                       if First then
  124.                       begin
  125.                         Write(' ':Len);
  126.                         Delete(S,P + 1,Len);
  127.                         GotoXY(X + P,Y);
  128.                       end;
  129.                       if Length(S) = Len then
  130.                         Delete(S,Len,1);
  131.                       P := succ(P);
  132.                       Insert(Ch,S,P);
  133.                       Write(Copy(S,P,Len));
  134.                     end
  135.                     else Beep;
  136.         ^S, LeftKey : if P > 0 then
  137.                         P := pred(P);
  138.         ^D, RightKey : if P < Length(S) then
  139.                          P := succ(P);
  140.          ^A, HomeKey : P := 0;
  141.          ^F, EndKey : P := Length(S);
  142.          ^G, DelKey  : if P < Length(S) then
  143.                        begin
  144.                          Delete(S,P + 1,1);
  145.                          Write(Copy(S,P + 1,Len),' ');
  146.                        end;
  147.                  BS : if P > 0 then
  148.                  begin
  149.                    Delete(S,P,1);
  150.                    Write(^H,Copy(S,P,Len),' ');
  151.                    P := pred(P);
  152.                  end;
  153.         ^Y : begin
  154.                Write(' ':Len);
  155.                Delete(S,P + 1,Len);
  156.              end;
  157.       else;
  158.     end;  {of case}
  159.     First := false;
  160.   until UpCase(Ch) in Term;
  161.   P := Length(S);
  162.   GotoXY(X + P,Y);
  163.   Write('' :Len - P);
  164.   TC := Upcase(Ch);
  165. end; { EditLine }
  166.  
  167. end.