home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / INPUT2.ZIP / INPUT2.PAS
Encoding:
Pascal/Delphi Source File  |  1986-11-08  |  12.3 KB  |  417 lines
  1. {.HE             Program --  Input - Formatted Data Entry Subroutine}
  2.  
  3.  
  4.  
  5.  
  6.  
  7. {Author - Henry R. Lifton           *      Version 1.00  2/19/85
  8.           3159 Jason Drive          *    Copyright 1985 - Henry R. Lifton
  9.           Bellmore, NY 11710        *    May be freely copied and 
  10.           (516) 785-3211 Home       *    distributed except for
  11.           (516) 752-9114 Business   *    commercial use
  12.  
  13.  
  14.  
  15.  
  16.                     Written in Turbo Pascal, Ver. 2.0
  17.  
  18.  
  19.  
  20.  
  21.  
  22.                    ALL     Suggestions Welcomed
  23.                            Questions Answered
  24.                            Contributions Accepted                         }
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.       { The purpose of this routine is to format the screen and
  32.         prevent it from being corrupted by unprotected input.
  33.         In addition it provides the ability to edit and correct
  34.         fields at will, before sending them to be processed
  35.         by the program.                                                   }
  36.  
  37.  
  38.  
  39.  
  40.  
  41.  
  42.      { The routine should be self documenting. Compiling and running
  43.        it will demonstrate its capabilities (also its limitations).
  44.        Just before the procedure 'LoadArray' is more information
  45.        on the variables and their usage.                                   }
  46.  
  47. {.PA}
  48.  
  49.  
  50. {The following should be declared in your program - all are global variables}
  51.  
  52.  
  53.  
  54. {$C-}      {Turns off the control character checking -- makes output faster }
  55.  
  56.  
  57.  
  58.  
  59. type
  60.    Ascii   = set of ' '..'~'; { Range of printable characters }
  61.    Entry   = string[35];      { String to hold entries - length=longest Entry }
  62.  
  63.  
  64.  
  65.  
  66. const
  67.    Upper:  Ascii = ['A'..'Z',' '];                           {Subsets of     }
  68.    Lower:  Ascii = ['a'..'z',' '];                           {Allowable      }
  69.    Nums:   Ascii = ['0'..'9',' ','.'];                       {Characters     }
  70.    Math:   Ascii = ['%'..'/','<'..'>','['..'`','{'..'~'];
  71.    All:    Ascii = [' '..'~'];
  72.    Bks   = #08;  { Backspace Key  }
  73.    Cr    = #13;  {Carriage return }
  74.    Ff    = 1;   { These constants represent the number of the first and last }
  75.    Lf    = 7;   { fields in the Entry and will change with each program      }
  76.  
  77.  
  78.  
  79.  
  80. var
  81.    Field:        integer;              { Field counter  }
  82.    Key:          array[1..2] of char;  { keystroke entered at the keyboard }
  83.                                        { Allows for function and special keys}
  84.    Ks:           char;                 { The character to print }
  85.    Ret,
  86.    Fini,
  87.    Done:         boolean;                     { True or False indicators }
  88.    Col,Row,                                   { Column and Row }
  89.    CurPos,                                    { Current cursor position }
  90.    PromptCol,                                 { Column for start of prompt }
  91.    Len:          array[Ff..Lf] of integer;    { Max. length of input field }
  92.    Prompt,Ans:   array[Ff..Lf] of Entry;      { Array for Prompts & Answers }
  93.    Uc:           array[Ff..Lf] of boolean;    { Array for setting upper case }
  94.    Allow:        array[Ff..Lf] of Ascii;      { Defines Allowable char. set  }
  95.  
  96.  
  97. {.PA}
  98.  
  99.  
  100.        {     Minor procedures - called often from main procedure       }
  101.  
  102.  
  103.  
  104.  
  105. procedure Bell;          {For when something goes wrong}
  106.   begin
  107.     Sound(440);
  108.     Delay(250);
  109.     NoSound;
  110.   end;    {Bell}
  111.  
  112.  
  113.  
  114. procedure Checkfield;   { See if field should wrap around }
  115.   begin
  116.     if Field<Ff then Field:=Lf;
  117.     if Field>Lf then Field:=Ff;
  118.   end;   { Checkfield }
  119.  
  120.  
  121.  
  122. procedure Brackets;     { Print Entry limiters }
  123.   begin
  124.     GotoXY(Col[Field]-1,Row[Field]);
  125.     Write('[');
  126.     GotoXY(Col[Field]+Len[Field],Row[Field]);
  127.     Write(']');
  128.   end;   { Brackets }
  129.  
  130.  
  131.  
  132. procedure NoBrackets;   {Remove Entry limiters }
  133.   begin
  134.     GotoXY(Col[Field]-1,Row[Field]);
  135.     Write(' ');
  136.     GotoXY(Col[Field]+Len[Field],Row[Field]);
  137.     Write(' ')
  138.   end;    { NoBrackets }
  139.  
  140.  
  141.  
  142.  
  143. {.PA}
  144.             { This is the main routine and calls all those above }
  145.  
  146. procedure GetInput;
  147.  
  148. begin  {GetInput}
  149.   Ret:=false;
  150.   repeat {until Ret}
  151.     Brackets;
  152.     begin                                      {Read the keyboard}
  153.       GotoXY(CurPos[Field],Row[Field]);
  154.       Read(kbd,Key[1]);
  155.       if (Key[1]=chr(27)) or (Key[1]=chr(0)) then
  156.         begin                                  {Read second keystroke}
  157.           Read(kbd,Key[2]);
  158.             case Key[2] of
  159.               #59: begin  {Function Key 1 pressed - all Done}
  160.                      Done:=true;   Ret:=true;    Fini:=true;
  161.                    end;   {Function Key 1 - all Done}
  162.               #72: begin  {Move back (up) one field}
  163.                      NoBrackets;
  164.                      Field:=Field-1;
  165.                    end;   {Move back}
  166.               #80: begin  {Move ahead (down) one field}
  167.                      NoBrackets;
  168.                      Field:=Field+1;
  169.                    end;   {Move ahead}
  170.               #75: begin  {Cursor Left (backwards) one stroke}
  171.                      CurPos[Field]:=CurPos[Field]-1;
  172.                      if CurPos[Field] <Col[Field] then
  173.                        begin  {Back one field}
  174.                          CurPos[Field]:=Col[Field]+Length(Ans[Field]);
  175.                          Bell;NoBrackets;
  176.                          Field:=Field-1;
  177.                        end;   {Back one field}
  178.                    end;   {Cursor left}
  179.               #77: begin  {Cursor right (ahead) one stroke}
  180.                      CurPos[Field]:=CurPos[Field]+1;
  181.                      if CurPos[Field] >Col[Field]+Len[Field] then
  182.                      begin  {Ahead one field}
  183.                        CurPos[Field]:=Col[Field]+Length(Ans[Field]);
  184.                        Bell;NoBrackets;
  185.                        Field:=Field+1;
  186.                      end;   {Ahead one field}
  187.                    end;   {Cursor right}
  188.               #82: begin  {Insert Key  pressed - this Entry o.k.}
  189.                       Done:=true;
  190.                       Ret:=true;
  191.                      end;   {Insert Key 1 }
  192.             end; {Case - second keystroke}
  193.           Checkfield; {check for first or last field overlow}
  194.         end;  {Read second keystroke}
  195.       Ks:=Key[1];  {Nothing very special so interpret Key[1]  }
  196.       case Ks of  {check keystroke for other meanings}
  197.         Cr:  begin  {carriage return}
  198.                NoBrackets;
  199.                Field:=Field+1;
  200.                Checkfield;
  201.              end;   {carriage return}
  202.         Bks: begin  {Should we backspace}
  203.                if  CurPos[Field]<=Col[Field] then Bell else
  204.                begin  {backspace}
  205.                  delete(Ans[Field],CurPos[Field]-Col[Field],1);
  206.                  CurPos[Field]:=CurPos[Field]-1;
  207.                  GotoXY(CurPos[Field],Row[Field]);
  208.                  Write(' ');
  209.                  GotoXY(CurPos[Field],Row[Field]);
  210.                end;  {backspace}
  211.              end; {should we backspace}
  212.       end; {Case Statement - Check keystroke}
  213. {Nothing there? -- must be a letter or number}
  214.  
  215. {If Uc is true - convert to upper case }
  216.       if Uc[Field] then  if Ks in ['a'..'z'] then Ks:=chr(ord(Ks)-32);
  217. { Now check if it is allowable }
  218.       if Ks in Allow[Field] then
  219.       begin  {check length of answer}
  220.         if Length(Ans[Field]) <= Len[Field] then
  221.         if CurPos[Field]-Col[Field]+1>Len[Field]  then  Bell else
  222.         begin                       {Write keystroke}
  223.           HighVideo;                {Bright screen  }
  224.           Write(Ks);
  225.           LowVideo;                 { Dim Screen }
  226.           delete(Ans[Field],CurPos[Field]-Col[Field]+1,1);
  227.           insert(Ks,Ans[Field],CurPos[Field]-Col[Field]+1);
  228.           CurPos[Field]:=CurPos[Field]+1;
  229.         end;                        {Write keystroke}
  230.       end;                          {check length of answer}
  231.     end;                            { Reading Keyboard }
  232.   until Ret;
  233.   NoBrackets;
  234.   for Field:=Ff to Lf do            {Clear entry fields}
  235.     begin
  236.       GotoXY(Col[Field],Row[Field]);
  237.       Write('':Len[Field]);
  238.     end;                            {Clear entry fields}
  239.   Field:=Ff;                        {Start at first field}
  240. end;                                {GetInput}
  241.  
  242.     { This is the end of the main routine - following is for program use}
  243. {.PA}
  244.  
  245. procedure Titles;
  246.  
  247.  
  248. type
  249.   T = string[80];
  250.  
  251.  
  252. var
  253.   Aa: integer;
  254.   Title: T;
  255.  
  256.  
  257. begin
  258.  
  259.   LowVideo;
  260.   Title:='This is the Title Line';aa:=0;
  261.   Aa:= (80-Length(Title)) div 2;
  262.   GotoXY(aa,2);Write(Title);
  263.   Title:='Ins. Key = Next Record -- F1 = All Finished';Aa:=0;
  264.   Aa:= (80-Length(title)) div 2;
  265.   GotoXY(Aa,21);Write(Title);
  266.   Title:='Use Up & Down Arrows to change fields';Aa:=0;
  267.   Aa:= (80-Length(title)) div 2;
  268.   GotoXY(Aa,23);Write(Title);
  269.  
  270. end;           {Titles}
  271.  
  272. {.PA}
  273. {Use this procedure to load the array holding the parameters for the entry}
  274. {  PromptCol = Column prompt is to start
  275.    Row       = Row of prompt and entry
  276.    Len       = Length of input field
  277.    Prompt    = Text of prompt
  278.    Col       = Column where input is to start (computed automatically)
  279.    CurPos    = Current cursor position (internal to the routine)
  280.    Ans       = The entry is returned to your program in this variable
  281.    Uc        = True or false for converting lower case entry to upper case
  282.    Allow     = The set of acceptable characters as defined earlier
  283. }
  284.  
  285.  
  286.  
  287.  
  288. procedure LoadArray;
  289. begin
  290.  for Field:=Ff to Lf do
  291.   begin  {do loop}
  292.    case Field OF
  293.     1:begin
  294.        PromptCol[Field]:=5;Row[Field]:=6;Len[Field]:=25;
  295.        Prompt[Field]:='Last Name ';
  296.        Col[Field]:=PromptCol[Field]+Length(Prompt[Field])+2;
  297.        CurPos[Field]:=Col[Field];
  298.        Ans[Field]:='';
  299.        Uc[Field]:=true;
  300.        Allow[Field]:=upper;
  301.       end;
  302.  
  303.     2:begin
  304.        PromptCol[Field]:=5;Row[Field]:=7;Len[Field]:=15;
  305.        Prompt[Field]:='First Name ';
  306.        Col[Field]:=PromptCol[Field]+Length(Prompt[Field])+2;
  307.        CurPos[Field]:=Col[Field];
  308.        Ans[Field]:='';
  309.        Uc[Field]:=true;
  310.        Allow[Field]:=upper;
  311.       end;
  312.  
  313.     3:begin
  314.        PromptCol[Field]:=38;Row[Field]:=7;Len[Field]:=1;
  315.        Prompt[Field]:='Initial ';
  316.        Col[Field]:=PromptCol[Field]+Length(Prompt[Field])+2;
  317.        CurPos[Field]:=Col[Field];
  318.        Ans[Field]:='';
  319.        Uc[Field]:=true;
  320.        Allow[Field]:=upper;
  321.       end;
  322.  
  323.     4:begin
  324.        PromptCol[Field]:=5;Row[Field]:=8;Len[Field]:=35;
  325.        Prompt[Field]:='Street Address ';
  326.        Col[Field]:=PromptCol[Field]+Length(Prompt[Field])+2;
  327.        CurPos[Field]:=Col[Field];
  328.        Ans[Field]:='';
  329.        Uc[Field]:=false;
  330.        Allow[Field]:=all;
  331.       end;
  332.  
  333.     5:begin
  334.        PromptCol[Field]:=5;Row[Field]:=9;Len[Field]:=15;
  335.        Prompt[Field]:='City ';
  336.        Col[Field]:=PromptCol[Field]+Length(Prompt[Field])+2;
  337.        CurPos[Field]:=Col[Field];
  338.        Ans[Field]:='';
  339.        Uc[Field]:=false;
  340.        Allow[Field]:=upper+lower;
  341.       end;
  342.  
  343.     6:begin
  344.        PromptCol[Field]:=35;Row[Field]:=9;Len[Field]:=2;
  345.        Prompt[Field]:='State ';
  346.        Col[Field]:=PromptCol[Field]+Length(Prompt[Field])+2;
  347.        CurPos[Field]:=Col[Field];
  348.        Ans[Field]:='';
  349.        Uc[Field]:=true;
  350.        Allow[Field]:=upper;
  351.       end;
  352.  
  353.     7:begin
  354.        PromptCol[Field]:=50;Row[Field]:=9;Len[Field]:=5;
  355.        Prompt[Field]:='Zip Code ';
  356.        Col[Field]:=PromptCol[Field]+Length(Prompt[Field])+2;
  357.        CurPos[Field]:=Col[Field];
  358.        Ans[Field]:='';
  359.        Uc[Field]:=true;
  360.        Allow[Field]:=nums;
  361.       end;
  362.  
  363.    end; {doloop}
  364.   end; {case}
  365. end; {LoadArray}
  366.  
  367. {.PA}
  368.  
  369. procedure Prompts;
  370. begin
  371.   for Field:=Ff to Lf do
  372.     begin
  373.       LowVideo;
  374.       GotoXY(PromptCol[Field],Row[Field]);
  375.       Write(Prompt[Field]) { prompt is from an array }
  376.     end;
  377. end;{Prompts}
  378.  
  379. procedure ReDisplay;
  380. begin
  381.   for Field:=Ff to Lf do
  382.      begin
  383.        GotoXY(Col[Field],Row[Field]+10);
  384.        Write('':Len[Field]);
  385.        GotoXY(Col[Field],Row[Field]+10);
  386.        WriteLn(Ans[Field]);
  387.      end;
  388.   Field:=Ff;
  389. end;                     {ReDisplay}
  390.  
  391.  
  392.         {This is the start of the Program}
  393.  
  394.  
  395. begin
  396.   Titles;
  397.   LoadArray;
  398.   Prompts;
  399.   Done:=false;Fini:=false;
  400.  
  401.   while not Fini do
  402.     repeat
  403.       Field:=Ff;
  404.       GetInput;
  405.       ReDisplay;
  406.       for Field:=Ff TO Lf do       {Initialize fields}
  407.         begin
  408.           CurPos[Field]:=Col[Field];
  409.         end;                       {Initialize fields}
  410.     until Done;
  411. end.   {Fini}
  412.  
  413.  
  414.  
  415.  
  416. {                 That's all, Folks                         }
  417.