home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OUT18.ZIP / INPUT.INC < prev    next >
Encoding:
Text File  |  1986-07-23  |  6.0 KB  |  217 lines
  1.  
  2.  
  3. const                      {single character codes for each of
  4.                             the special keys on the keyboard}
  5.    BACKSPC  = #8;
  6.    TAB      = #9;
  7.    NEWLINE  = #13;
  8.    ESC      = #27;
  9.  
  10.    F1       = #128;
  11.    F2       = #129;
  12.    F3       = #130;
  13.    F4       = #131;
  14.    F5       = #132;
  15.    F6       = #133;
  16.    F7       = #134;
  17.    F8       = #135;
  18.    F9       = #136;
  19.    F10      = #137;
  20.  
  21.    HOME     = #140;
  22.    UP       = #141;
  23.    PGUP     = #142;
  24.    LEFT     = #144;
  25.    RIGHT    = #146;
  26.    ENDLINE  = #148;
  27.    DOWN     = #149;
  28.    PGDN     = #150;
  29.    INS      = #151;
  30.    DEL      = #152;
  31.  
  32.  
  33. type
  34.    anystring = string[128];
  35.  
  36.  
  37.  
  38. function getkey: char;      {get a key; map special keys into the
  39.                              matching symbolic constant}
  40. var
  41.    c:  char;
  42.  
  43. begin
  44.    read(kbd,c);                           {read a key}
  45.  
  46.    if (c = ESC) and keypressed then       {if this is a funtion key, then
  47.                                            read the second byte and convert
  48.                                            it into a special key code}
  49.    begin
  50.       read(kbd,c);
  51.       c := chr(ord(c) + 69);   {this makes F1=#128}
  52.    end;
  53.  
  54.    getkey := c;
  55. end;
  56.  
  57.  
  58.  
  59.  
  60. procedure edit_string(x,y:      integer;   {cursor position}
  61.                       col:      integer;   {initial column in buffer}
  62.                       var str:  anystring; {buffer to input}
  63.                       var c:    char;      {exit character from input}
  64.                       maxlen:   integer);  {max length of input}
  65.                                             {provide full text editing
  66.                                              on the contents of a string
  67.                                              variable; processes most
  68.                                              editing keys.  this is where
  69.                                              all the time is spent while
  70.                                              waiting on the user}
  71. var
  72.    i:   integer;
  73.  
  74. begin
  75.  
  76.    gotoxy(x+length(str),y);
  77.  
  78.    lowvideo;
  79.    for i := length(str) to maxlen do
  80.       write('_');
  81.                                           {display underscores out to the
  82.                                            end of the field.  this lets
  83.                                            the user know when he is near
  84.                                            the end of line}
  85.    normvideo;
  86.  
  87.    repeat
  88.       if col > length(str) then
  89.          col := length(str)+1;            {if i am beyond end of string,
  90.                                            move cursor back to first legal
  91.                                            position}
  92.  
  93.       gotoxy(x+col-1,y);
  94.       c := getkey;                        {position the cursor and wait for an
  95.                                            input from the user}
  96.  
  97.  
  98.       case c of                           {switch on the key and do what
  99.                                            ever is needed}
  100.  
  101.          HOME:      col := 1;
  102.  
  103.  
  104.          ENDLINE:   col := length(str) + 1;
  105.  
  106.  
  107.          TAB:       repeat
  108.                        col := col + 1;
  109.                     until (col mod 4) = 0;
  110.  
  111.  
  112.          LEFT:      if col > 1 then
  113.                        col := col - 1
  114.                     else
  115.                        write(^G);
  116.  
  117.  
  118.          RIGHT:     col := col + 1;
  119.  
  120.  
  121.          INS:       if col <= length(str) then
  122.                     begin
  123.                        insert(' ',str,col);
  124.                        write(copy(str,col,99));
  125.                     end;
  126.  
  127.  
  128.          DEL:       if col <= length(str) then
  129.                     begin
  130.                        delete(str,col,1);
  131.                        write(copy(str,col,99));
  132.                        lowvideo;
  133.                        write('_');
  134.                        normvideo;
  135.                     end
  136.                     else
  137.                        write(^G);
  138.  
  139.  
  140.          BACKSPC:   if col > 1 then
  141.                     begin
  142.                        col := col - 1;
  143.                        delete(str,col,1);
  144.                        write(^H+copy(str,col,99));
  145.                        lowvideo;
  146.                        write('_');
  147.                        normvideo;
  148.                     end
  149.                     else
  150.                        write(^G);
  151.  
  152.  
  153.          NEWLINE:   col := 1;
  154.  
  155.  
  156.          UP,
  157.          DOWN,
  158.          PGUP,
  159.          PGDN,
  160.          ESC,
  161.          F1..F10:   ;
  162.  
  163.  
  164.          else       begin
  165.                        if col = (maxlen-7) then
  166.                        begin
  167.                           sound(1200);         {make a quick beep when
  168.                                                 getting close to the end
  169.                                                 of a line}
  170.                           delay(100);
  171.                           nosound;
  172.                        end;
  173.  
  174.                        if col > length(str) then
  175.                           if length(str) < maxlen then
  176.                           begin
  177.                              str := str + c;
  178.                              col := col + 1;
  179.                              write(c);           {add to end of string
  180.                                                   if there is room}
  181.                           end
  182.                           else
  183.                              write(^G)           {beep if no more room}
  184.                        else
  185.                        begin
  186.                           str[col] := c;
  187.                           col := col + 1;       {replace in middle of string}
  188.                           write(c);
  189.                        end;
  190.  
  191.                     end;
  192.       end;
  193.  
  194.    until c in [UP,DOWN,PGUP,PGDN,NEWLINE,ESC,F1..F10];
  195.  
  196.  
  197.    gotoxy(x+length(str),y);
  198.    clreol;                             {input is finished, remove the extra
  199.                                         underscores from the screen}
  200. end;
  201.  
  202.  
  203. var
  204.    buffer: anystring;
  205.    key:    char;
  206.  
  207. begin {example}
  208.    clrscr;
  209.    gotoxy(1,1);
  210.    write('Name: [..........]');
  211.  
  212.    edit_string(8,1, 1,buffer, key, 10);
  213.  
  214.    writeln;
  215.    writeln('You typed: <',buffer,'>');
  216. end.
  217.