home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / userlib.com / USERLIB.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-11-29  |  18.9 KB  |  633 lines
  1. Unit UserLib;
  2. interface
  3.   uses crt,dos;
  4. {
  5.  Userlib is a Turbo Pascal 5.5 unit containing several useful functions
  6.  for screen I/O, menus, etc..  Several of the routines are versions of the
  7.  routines contained in TPIO22.ARC from the Computer Lang. Forum
  8. }
  9. type
  10.   MenuList = Array[0..9] of String[40];  {Array of menu text choices}
  11.  
  12. const
  13.   HexChars : Array[1..16] of Char =
  14.   ('0','1','2','3','4','5','6','7',
  15.    '8','9','A','B','C','D','E','F');
  16. {keyboard constants}
  17. {ASCII   Dec            Description}
  18.   NUL  = #000; {CTRL @  Null}
  19.   SOH  = #001; {CTRL A  Start of header}
  20.   STX  = #002; {CTRL B  Start of text}
  21.   ETX  = #003; {CTRL C  End of text}
  22.   EOT  = #004; {CTRL D  End of transmission}
  23.   ENQ  = #005; {CTRL E  Enquiry}
  24.   ACK  = #006; {CTRL F  Acknowledge}
  25.   BEL  = #007; {CTRL G  Bell}
  26.   BS   = #008; {CTRL H  Backspace}
  27.   TAB  = #009; {CTRL I  Horizontal tab}
  28.   LF   = #010; {CTRL J  Line Feed}
  29.   VT   = #011; {CTRL K  Vertical tab}
  30.   FF   = #012; {CTRL L  Form feed}
  31.   CR   = #013; {CTRL M  Carriage return}
  32.   SO   = #014; {CTRL N  Shift out}
  33.   SI   = #015; {CTRL O  Shift in}
  34.   DLE  = #016; {CTRL P  Data link escape}
  35.   DC1  = #017; {CTRL Q  Dev. control 1 (XON)}
  36.   DC2  = #018; {CTRL R  Dev. control 2}
  37.   DC3  = #019; {CTRL S  Dev. control 3 (XOFF)}
  38.   DC4  = #020; {CTRL T  Dev. control 4}
  39.   NAK  = #021; {CTRL U  Negative acknowledge}
  40.   SYN  = #022; {CTRL V  Synchronous idle (SYNC)}
  41.   ETB  = #023; {CTRL W  End of transmission block}
  42.   CAN  = #024; {CTRL X  Cancel}
  43.   EM   = #025; {CTRL Y  End of medium}
  44.   SUB  = #026; {CTRL Z  Substitute}
  45.   ESC  = #027; {CTRL [  Escape}
  46.   FS   = #028; {CTRL \  File seperator}
  47.   GS   = #029; {CTRL ]  Group seperator}
  48.   RS   = #030; {CTRL ^  Record seperator}
  49.   US   = #031; {CTRL _  Unit seperator}
  50. { #032 to #0126 are normal ASCII characters}
  51. { DEL  = #127; (Delete/Rubout) }
  52. {translated extended codes
  53.  codes above 127 are not generated directly from keyboard
  54.  they are translations of the actual 2 character sequence
  55.  (NUL xx) obtained by adding 128 to the xx character}
  56.   F1   = #187;
  57.   F2   = #188;
  58.   F3   = #189;
  59.   F4   = #190;
  60.   F5   = #191;
  61.   F6   = #192;
  62.   F7   = #193;
  63.   F8   = #194;
  64.   F9   = #195;
  65.   F10  = #196;
  66.   HOMEKEY  = #199;
  67.   UPKEY    = #200;
  68.   PGUPKEY  = #201;
  69.   LEFTKEY  = #203;
  70.   RIGHTKEY = #205;
  71.   ENDKEY   = #207;
  72.   DOWNKEY  = #208;
  73.   PGDNKEY  = #209;
  74.   INSKEY   = #210;
  75.   DELKEY   = #211;
  76.   CTRLLEFTKEY  = #243;
  77.   CTRLRIGHTKEY = #244;
  78.  
  79. var
  80.   Bgnd,             {backgound text color}
  81.   Txt    : byte;    {text character color}
  82.   Field  : integer; {number of current field on input screen}
  83.  
  84.  
  85. procedure Abort(msg:String);
  86. {display message and halt}
  87.  
  88. procedure Beep;
  89. {sound beeper}
  90.  
  91. procedure CursorType(S:char);
  92. {set cursor to Block, Underline or invisible}
  93.  
  94. procedure ClrLine(Col,Row:byte);
  95. {clear line to spaces on crt}
  96.  
  97. function Exists(FileName : String) : Boolean;
  98. { Returns True if the file FileName exists, False otherwise }
  99.  
  100. function GetHex(Dval:Word):string;
  101. {convert word to hex string}
  102.  
  103. function PadStr(S:string; L:byte; C:char; J:char):string;
  104. {pad string S to length L with character C justified J('R' or 'L')}
  105.  
  106. function PurgeCh(InS:string; C:char):string;
  107. {delete all occurences of C from S}
  108.  
  109. procedure Display_Int(Col,Row,Txt,Bgnd:byte; Rev:Boolean;
  110.                       I:integer; Width:byte);
  111. { Write an integer on screen at Col,Row with chosen colors
  112.   in reverse video if Rev is true}
  113.  
  114. procedure Display_Real(Col,Row,Txt,Bgnd:byte; Rev:Boolean;
  115.                        R:real; Width,Dec:byte);
  116. { Write a real number on screen}
  117.  
  118. procedure Display_Str(Col,Row,Txt,Bgnd:byte; Rev:Boolean;
  119.                       S:String);
  120. { Write a string on screen}
  121.  
  122. function KeyInp : Char;
  123. { Reads the next keyboard character, translates special keys }
  124.  
  125. function Yes_No(Prompt:string):char;
  126. {print message on line 24 and wait for input}
  127.  
  128. procedure Pause;
  129. {print message on line 24 and wait for input}
  130.  
  131. procedure Message(Msg:String);
  132. {display msg on line 23 and pause}
  133.  
  134. procedure Menu(var Items: MenuList; var Choice: integer;
  135.                   Max,Txt,Bgnd:byte);
  136. {display a list of items and return selection
  137.  Parameters are Items - array of items to display
  138.                 Choice - number of item chosen
  139.                 Max - number of items
  140.                 Txt - Text Color
  141.                 Bgnd - Background Color}
  142.  
  143. procedure Inp_Int(Col,Row,Txt,Bgnd:byte;
  144.                   var I:integer; Max:byte);
  145. {Input an integer up to max digits from screen at Col,Row}
  146.  
  147. procedure Inp_Real(Col,Row,Txt,Bgnd:byte;
  148.                    var R:real; Max,Frac:byte);
  149. {Input a real number from screen - Max chars (including sign & decimal point)
  150.  with up to Frac decimal places}
  151.  
  152. procedure Inp_Str(Col,Row,Txt,Bgnd:byte;
  153.                       var S:String; Max:byte; Shift:char);
  154. {Input a string from screen at Col,Row in a reverse video box}
  155.  
  156. {******************************************************************************}
  157. {******************************************************************************}
  158. implementation
  159.  
  160. procedure Abort(msg:String);
  161. begin
  162.   ClrScr;
  163.   Writeln(msg);
  164.   Halt;
  165. end; {Abort}
  166. {******************************************************************************}
  167. procedure Beep;
  168. begin
  169.   Write(BEL);
  170. end; {Beep}
  171. {******************************************************************************}
  172. procedure CursorType(S:char);
  173.  
  174. procedure Set_Cursor(Hi_scan_line, Low_scan_line: byte);
  175. var regs: registers;
  176. begin
  177.   regs.ax := $0100;            {ah = 01h; al = 00h}
  178.   regs.ch := Hi_scan_line;
  179.   regs.cl := Low_scan_line;
  180.   intr($10,regs)               {call DOS cursor services}
  181. end; {Set_Cursor}
  182.  
  183. begin {CursorType}
  184.   case S of
  185.   'B': Set_Cursor(0,7);   {Block}
  186.   'O': Set_Cursor(15,15); {invisible}
  187.   'U': Set_Cursor(6,7);   {Underline}
  188.   end;
  189. end; {CursorType}
  190. {******************************************************************************}
  191. procedure ClrLine(Col,Row:byte);
  192. {clear line to spaces on crt}
  193. begin
  194.   GotoXY(Col,Row);
  195.   ClrEol;
  196. end; {ClrLine}
  197. {******************************************************************************}
  198. procedure Display_Int(Col,Row,Txt,Bgnd:byte; Rev:Boolean;
  199.                       I:integer; Width:byte);
  200. { Writes an integer in a particular location, possibly reverse video}
  201. begin
  202.   if not Rev then
  203.     begin
  204.       TextColor(Txt);
  205.       TextBackground(Bgnd);
  206.     end
  207.   else
  208.     begin
  209.       TextColor(Bgnd);
  210.       TextBackground(Txt);
  211.     end;
  212.   GotoXY(Col,Row);
  213.   Write(I:Width);
  214. end; { Display_Int }
  215. {******************************************************************************}
  216. procedure Display_Real(Col,Row,Txt,Bgnd:byte; Rev:Boolean;
  217.                        R:real; Width,Dec:byte);
  218. { Writes a real number in a particular location, possibly reverse video}
  219. begin
  220.   if not Rev then
  221.     begin
  222.       TextColor(Txt);
  223.       TextBackground(Bgnd);
  224.     end
  225.   else
  226.     begin
  227.       TextColor(Bgnd);
  228.       TextBackground(Txt);
  229.     end;
  230.   GotoXY(Col,Row);
  231.   Write(R:Width:Dec);
  232. end; { Display_Real }
  233. {******************************************************************************}
  234. procedure Display_Str(Col,Row,Txt,Bgnd:byte; Rev:Boolean;
  235.                       S:String);
  236. { Writes text in a particular location, possibly reverse video}
  237. begin
  238.   if not Rev then
  239.     begin
  240.       TextColor(Txt);
  241.       TextBackground(Bgnd);
  242.     end
  243.   else
  244.     begin
  245.       TextColor(Bgnd);
  246.       TextBackground(Txt);
  247.     end;
  248.   GotoXY(Col,Row);
  249.   Write(S);
  250. end; { Display_Str }
  251. {******************************************************************************}
  252. function Exists(FileName : String) : Boolean;
  253. { Returns True if the file FileName exists, False otherwise }
  254. var
  255.   SR : SearchRec;
  256. begin
  257.   FindFirst(FileName, ReadOnly + Hidden + SysFile, SR);
  258.   Exists := (DosError = 0) and (Pos('?', FileName) = 0) and
  259.             (Pos('*', FileName) = 0);
  260. end; { Exists }
  261. {******************************************************************************}
  262. function GetHex(Dval:Word):string;
  263. var
  264.   Digit,Cntr,Divisor,Quotient:integer;
  265.   TS:string;
  266. begin
  267.   GetHex := '';
  268.   TS := '';
  269.   For Digit := 1 to 4 do
  270.     begin
  271.       Divisor := 1;
  272.       for cntr := Digit to 3 do
  273.         Divisor := Divisor * 16;
  274.       Quotient := Dval DIV Divisor;
  275.       Dval := Dval MOD Divisor;
  276.       TS := TS+HexChars[Quotient+1];
  277.     end;
  278.   GetHex := TS;
  279. end;
  280. {******************************************************************************}
  281. function KeyInp : Char;
  282. { Reads the next keyboard character, handles special keys }
  283. var
  284.   C : Char;
  285. begin
  286.   C := ReadKey;
  287.   repeat
  288.       if C = NUL then
  289.       begin {extended key}
  290.         C := ReadKey; {get second byte of extended code}
  291.     KeyInp := Chr(Ord(C) + 128); {translate it up}
  292.       end
  293.     else {normal key}
  294.     KeyInp := C;
  295.   until C <> NUL;
  296. end; { KeyInp }
  297. {******************************************************************************}
  298. function Yes_No(Prompt:string):char;
  299. {print message on line 24 and wait for input}
  300. var
  301.   ch: char;
  302. begin
  303.   ClrLine(1,24);
  304.   Display_Str(((80-(length(Prompt)+5)) div 2),24,White,Black,True,
  305.               Prompt+'(Y/N)');
  306.   repeat
  307.     ch := KeyInp;
  308.   until ch in ['N','Y','n','y'];
  309.   TextBackground(Bgnd);
  310.   TextColor(Txt);
  311.   ClrLine(1,24);
  312.   Yes_No := Upcase(ch);
  313. end; {Yes_No}
  314. {******************************************************************************}
  315. procedure Pause;
  316. {print message on line 24 and wait for input}
  317. var
  318.   ch: char;
  319. begin
  320.   ClrLine(1,24);
  321.   Display_Str(26,24,White,Black,True,'PRESS SPACE BAR TO CONTINUE');
  322.   repeat
  323.     ch := KeyInp;
  324.   until ch = ' ';
  325.   TextBackground(Bgnd);
  326.   TextColor(Txt);
  327.   ClrLine(1,24);
  328. end; {Pause}
  329. {******************************************************************************}
  330. procedure Message(Msg:String);
  331. {display message on line 23 and pause}
  332. begin
  333.   Beep;
  334.   ClrLine(1,23);
  335.   Display_Str(((80-length(msg)) div 2),23,White,Black,True,Msg);
  336.   Pause;
  337.   ClrLine(1,23);
  338. end; {Message}
  339. {******************************************************************************}
  340. procedure Menu(var Items: MenuList; var Choice: integer;
  341.                Max,Txt,Bgnd:byte);
  342. {display a list of items and return selection
  343.  Parameters are Items - array of items to display
  344.                 Choice - number of item chosen
  345.                 Max - number of items
  346.                 Txt - Text Color
  347.                 Bgnd - Background Color}
  348. const
  349.   Normal = False;
  350. var
  351.   inp: char; i,j,l,x,y: integer; TS:string;
  352. begin
  353.   TextColor(Txt);           {set colors and clear screen}
  354.   TextBackground(Bgnd);
  355.   ClrScr;
  356.   i := Choice;               {set pointer to item to highlight first}
  357.   Choice := -1;              {set choice to invalid selection}
  358.   y := (24-2*(Max+1)) div 2; {vertical centering}
  359.   l := length(Items[0]);     {find length of longest item including title}
  360.   for j := 1 to Max do
  361.     if length(Items[j]) > l then l := length(Items[j]);
  362.   x := (80-(l+2)) div 2;         {horizontal centering}
  363.   Display_Str(x,y,Txt,Bgnd,Normal,Items[0]);     {display title}
  364.   repeat                            {display items, highlight current item}
  365.     For j := 1 to Max do
  366.       begin
  367.         str(j:1,TS);
  368.         TS := TS+'-'+Items[j];
  369.         Display_Str(x,y+j*2,Txt,Bgnd,i=j,TS);
  370.       end;
  371.     inp := KeyInp;                  {get keyboard input}
  372.     case inp of
  373.       CR      : Choice := i;       {selects current item}
  374.       ESC     : Choice := 0;       {skip out of menu - no selection}
  375.       DOWNKEY : i := succ(i);      {move down list}
  376.       UPKEY   : i := pred(i);      {move up list}
  377.       HOMEKEY : i := 1;
  378.       ENDKEY  : i := Max;
  379.       '1'..'9': begin
  380.                   i := Ord(inp)-48;
  381.                   if i in [1..Max] then
  382.                     Choice := i;
  383.                 end;
  384.     end;
  385.     if i < 1 then i := Max;         {limit movement}
  386.     if i > Max then i := 1;
  387.   until Choice in [0..Max];         {loop until valid choice}
  388.   TextColor(Txt);                  {set colors and clear screen}
  389.   TextBackground(Bgnd);
  390.   ClrScr;
  391. end; {Do_Menu}
  392. {******************************************************************************}
  393. function PadStr(S:string; L:byte; C:char; J:char):string;
  394. {pad string S to length L with character C justified J('R' or 'L')}
  395. var TS:string;
  396. begin
  397.   TS := S;
  398.   if length(TS) < L then
  399.     repeat
  400.       case J of
  401.         'L': TS := TS+C;
  402.         'R': insert(C,TS,1);
  403.       end;
  404.     until length(TS) = L;
  405.   PadStr := TS;
  406. end;
  407. {******************************************************************************}
  408. procedure Add_to_Str(var S:string; C:char; var P,Max:byte);
  409. {add C to S at P limited to Max length}
  410. begin
  411.   if length(S) < Max then
  412.     begin
  413.       P := succ(P);
  414.       insert(C,S,P);
  415.     end;
  416. end; {Add_to_Str}
  417.  
  418. procedure Adj_Str(var S:string; C:char; var P,Max:byte);
  419. {adjust position of cursor within string, delete chars, etc.}
  420. begin
  421.   case C of
  422.     LEFTKEY : if P > 0 then P := pred(P);
  423.     RIGHTKEY: if P < length(S) then P := succ(P);
  424.     BS      : if P > 0 then
  425.                 begin
  426.                   delete(S,P,1);
  427.                   P := pred(P);
  428.                 end;
  429.     DELKEY  : if P < length(S) then delete(S,P+1,1);
  430.   end {case}
  431. end; {Adj_Str}
  432.  
  433. function PurgeCh(InS:string; C:char):string;
  434. {delete all occurences of C from S}
  435. var
  436.   n: byte; OutS:string;
  437. begin
  438.   OutS := '';
  439.   for n := 1 to length(InS) do
  440.     if InS[n] = C then
  441.     else OutS := OutS+InS[n];
  442.   PurgeCh := OutS;
  443. end; {PurgeCh}
  444.  
  445. procedure StripCh(var InS:string; C:char);
  446. {delete leading occurences of C from S}
  447. begin
  448.   while (length(InS) > 0) and (InS[1] = C) do
  449.     delete(InS,1,1);
  450. end;
  451.  
  452. procedure Field_Cntrl(C:char);
  453. begin {Field_Cntrl}
  454.   case C of
  455.     ESC         : Field := -1;
  456.     CR, DOWNKEY : Field := succ(Field);
  457.     UPKEY       : Field := pred(Field);
  458.   end;
  459. end;
  460. {------------------------------------------------------------------------------}
  461. procedure Inp_Int(Col,Row,Txt,Bgnd:byte;
  462.                   var I:integer; Max:byte);
  463. {Input an integer up to max digits from screen at Col,Row}
  464. type
  465.   charset = set of char;
  466. const
  467.   Adjusting   : charset = [BS, LEFTKEY, RIGHTKEY, DELKEY];
  468.   Numeric     : charset = ['0'..'9'];
  469.   Terminating : charset = [ESC, CR, DOWNKEY, UPKEY];
  470. var
  471.   P: byte; C:char; code:integer; S:string;
  472. begin
  473.   code := 0;
  474.   CursorType('U');
  475.   str(I:Max,S); {convert to string}
  476.   S := PurgeCh(S,' ');
  477.   StripCh(S,'0');
  478.   P := length(S);
  479.   repeat
  480.     Display_Str(Col,Row,Txt,Bgnd,TRUE,PadStr(S,Max,' ','L'));
  481.     gotoXY(Col+P,Row);
  482.     C := KeyInp;
  483.     if C in Adjusting then Adj_Str(S,C,P,Max)
  484.     else if C = '-' then
  485.            begin
  486.              if (pos('-',S) = 0) and
  487.                 (length(S) < Max) and
  488.                 (P = 0) then Add_to_Str(S,C,P,Max);
  489.            end
  490.     else if C in Numeric then Add_to_Str(S,C,P,Max)
  491.     else if C in Terminating then
  492.            begin
  493.              Field_Cntrl(C);
  494.              if C = ESC then S :='';
  495.            end
  496.     else Beep;
  497.   until C in Terminating;
  498.   if S = '' then I := 0
  499.   else val(S,I,code);
  500.   if code = 0 then Display_Int(Col,Row,Txt,Bgnd,FALSE,I,Max)
  501.   else begin
  502.          gotoXY(1,24);
  503.          write('*** CONVERSION ERROR ***',BEL);
  504.          halt;
  505.        end;
  506.   CursorType('O');
  507. end; {Inp_Int}
  508. {------------------------------------------------------------------------------}
  509. procedure Inp_Real(Col,Row,Txt,Bgnd:byte;
  510.                    var R:real; Max,Frac:byte);
  511. {Input a real number from screen - Max chars (including sign & decimal point)
  512.  with up to Frac decimal places}
  513. type
  514.   charset = set of char;
  515. const
  516.   Adjusting   : charset = [BS, LEFTKEY, RIGHTKEY, DELKEY];
  517.   Numeric     : charset = ['.','0'..'9'];
  518.   Terminating : charset = [ESC, CR, DOWNKEY, UPKEY];
  519. var
  520.   P,Pdec,Wmax,Wlen,Flen: byte; C: char; code: integer; S: string;
  521.  
  522. procedure RealStrLen;
  523. begin {RealStrLen}
  524.   Pdec := pos('.',S);
  525.   if Pdec = 0 then
  526.     begin {no decimal point}
  527.       Wlen := length(S);
  528.       Flen := 0;
  529.     end
  530.   else
  531.     begin {decimal point present}
  532.       Wlen := Pdec;
  533.       Flen := length(S)-Wlen;
  534.     end;
  535. end; {RealStrLen}
  536.  
  537. procedure Add_to_RealStr;
  538. begin {Add_to_RealStr};
  539.   Pdec := pos('.',S);
  540.   if C = '.' then  {handle decimal point}
  541.     begin
  542.       if (Pdec = 0) and (length(S)-P <= Frac) then Add_to_Str(S,C,P,Max);
  543.     end
  544.   else  {digit}
  545.     {check to see if it goes in whole part}
  546.     if ((Pdec = 0) and (Wlen < Wmax -1))  {no decimal pt}
  547.        or ((Pdec > 0) and (Wlen < Wmax) and (P < Pdec))  {room to fit}
  548.           then Add_to_Str(S,C,P,Max)
  549.     else {try frac part}
  550.       if (Pdec <> 0) and (Flen < Frac) and (P >= Pdec) then
  551.         Add_to_Str(S,C,P,Max);
  552. end; {Add_to_RealStr}
  553.  
  554. begin {Inp_Real}
  555.   code := 0;
  556.   Wmax := Max-Frac;
  557.   CursorType('U');
  558.   if R <> 0.0 then str(R:Max:Frac,S) {convert to string}
  559.   else S := '';
  560.   S := PurgeCh(S,' ');
  561.   StripCh(S,'0');
  562.   P := length(S);
  563.   repeat
  564.     Display_Str(Col,Row,Txt,Bgnd,TRUE,PadStr(S,Max,' ','L'));
  565.     gotoXY(Col+P,Row);
  566.     C := KeyInp;
  567.     RealStrLen; {compute length of parts}
  568.     if C in Adjusting then Adj_Str(S,C,P,Max)
  569.     else if C = '-' then
  570.            begin
  571.              if (pos('-',S) = 0) and (P = 0) and
  572.                 (((Pdec = 0) and (Wlen < Wmax-1)) or
  573.                  ((Pdec <> 0) and (Wlen < Wmax))) then Add_to_Str(S,C,P,Max);
  574.            end
  575.     else if C in Numeric then Add_to_RealStr
  576.     else if C in Terminating then
  577.            begin
  578.              Field_Cntrl(C);
  579.              if C = ESC then S := '';
  580.            end
  581.     else Beep
  582.   until C in Terminating;
  583.   {input complete - convert back to Real}
  584.   if (S = '') or (S = '-') or (S = '.') or (S = '-.') then R := 0.0
  585.   else val(S,R,code);
  586.   if code = 0 then Display_Real(Col,Row,Txt,Bgnd,FALSE,R,Max,Frac)
  587.   else begin
  588.          gotoXY(1,24);
  589.          write('*** CONVERSION ERROR ***',BEL);
  590.          halt;
  591.        end;
  592.   CursorType('O');
  593. end; {Inp_Real}
  594. {------------------------------------------------------------------------------}
  595. procedure Inp_Str(Col,Row,Txt,Bgnd:byte;
  596.                   var S:String; Max:byte;Shift:char);
  597. {Input a string from screen at Col,Row}
  598. type
  599.   charset = set of char;
  600. const
  601.   Adjusting   : charset = [BS, LEFTKEY, RIGHTKEY, DELKEY];
  602.   Display     : charset = [' '..'~'];
  603.   Terminating : charset = [ESC, CR, DOWNKEY, UPKEY];
  604. var
  605.   P: byte; C:char; Up:boolean;
  606.  
  607. begin {Inp_Str}
  608.   Up := UpCase(Shift) = 'U';
  609.   CursorType('U');
  610.   P := length(S);
  611.   repeat
  612.     Display_Str(Col,Row,Txt,Bgnd,TRUE,PadStr(S,Max,' ','L'));
  613.     gotoXY(Col+P,Row);
  614.     C := KeyInp;
  615.     if C in Adjusting then Adj_Str(S,C,P,Max)
  616.     else if C in Display then
  617.            begin
  618.              if Up then C := Upcase(C);
  619.              Add_to_Str(S,C,P,Max);
  620.            end
  621.     else if C in Terminating then
  622.            begin
  623.              Field_Cntrl(C);
  624.              if C = ESC then S := '';
  625.            end
  626.     else Beep;
  627.   until C in Terminating;
  628.   CursorType('O');
  629.   Display_Str(Col,Row,Txt,Bgnd,FALSE,PadStr(S,Max,' ','L'));
  630. end {Inp_str};
  631. {******************************************************************************}
  632. end.
  633.