home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / news / 558 / field3 / fld3test.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-11  |  10KB  |  338 lines
  1. Program field_3_test;  { FLD3TEST.PAS }
  2.  
  3. Uses Crt,Dos,field3;
  4.  
  5. { This program was developed by Frank Wood to test the field2 unit.
  6.   It allows most of the features of FIELD3.PAS to be tested and will
  7.   permit a new user to get a feel for the unit.  It is also a rather
  8.   elaborate demonstration of the field3 function getpick. }
  9.  
  10. Type linestring = String[80];
  11.      direction = (up,down,left,right);
  12.      fieldnumber = 1..11;
  13.  
  14. Const nextfldnum: Array[fieldnumber,direction] Of Byte
  15.                   = ((3,2,9,4),
  16.                      (1,3,9,5),
  17.                      (2,1,10,6),
  18.                      (6,5,1,7),
  19.                      (4,6,2,8),
  20.                      (5,4,3,8),
  21.                      (8,8,4,9),
  22.                      (7,7,5,10),
  23.                      (10,10,7,1),
  24.                      (9,9,8,3),
  25.                      (10,1,10,1));
  26.  
  27. Var pickcount,titlenumber,fldnum,maxfldnum,keyreturn: Byte;
  28.     title1,items1,title2,items2,title3,items3: Byte;
  29.     title4,items4,title5,items5,title6,items6: Byte;
  30.     title7,items7,title8,items8,title9,items9: Byte;
  31.     title10,items10,col,row,len,decpla: Byte;
  32.     rv,ft,rq,cl,fl,rw,dp,zv,hitc,lotc: Byte;
  33.     required: Boolean;
  34.     pointer,marker: Char;
  35.     title,strbuf: linestring;
  36.     intbuf: Integer;
  37.     decbuf: Real;
  38.     fldtype: fldtypes;
  39.     picklist: Array[1..64] Of String[30];
  40.  
  41. Procedure writepicklist(col,row,maxpick,titlenumber: Byte);
  42.  
  43. Begin
  44.   GotoXY(col,row);
  45.   Write(picklist[titlenumber]);
  46.   For pickcount:=1 To maxpick Do
  47.     Begin
  48.       GotoXY(col+1,row+pickcount);
  49.       Write(marker,' ',picklist[titlenumber+pickcount])
  50.     End;
  51. End;
  52.  
  53. Begin  { Demo program }
  54.   reversevideo:=False;
  55.   zerovoid:=True;
  56.   hitxtcolor:=Yellow;
  57.   lotxtcolor:=LightGray;
  58.   txtbkgnd:=Black;
  59.   pointer:=chr(pickpointer);
  60.   marker:=chr(pickmarker);
  61.   cursor(hidden);
  62.   TextMode(CO80);
  63.   TextColor(lotxtcolor);
  64.   TextBackground(txtbkgnd);
  65.   ClrScr;
  66.  
  67.   { Display headings and default values }
  68.   GotoXY(43,1);Write('Test Program for FIELD3.TPU');
  69.  
  70.   { Define picklists }
  71.   picklist[1]:='Display Styles:';
  72.   picklist[2]:='Inverse Video';
  73.   picklist[3]:='Marker Blocks';
  74.   title1:=1;
  75.   items1:=2;
  76.   rv:=2;
  77.   picklist[4]:='Field Types:';
  78.   picklist[5]:='All Symbols';
  79.   picklist[6]:='Lower ASCII';
  80.   picklist[7]:='Capital Letters';
  81.   picklist[8]:='Numbers (String)';
  82.   picklist[9]:='Integer';
  83.   picklist[10]:='Signed Integer';
  84.   picklist[11]:='Unsign Dec Form';
  85.   picklist[12]:='Dec Form w Sign';
  86.   picklist[13]:='Free Form Real';
  87.   picklist[14]:='Real FF w Sign';
  88.   title2:=4;
  89.   items2:=10;
  90.   ft:=8;
  91.   picklist[15]:='Field Input:';
  92.   picklist[16]:='Optional';
  93.   picklist[17]:='Manditory';
  94.   title3:=15;
  95.   items3:=2;
  96.   rq:=1;
  97.   picklist[18]:='Column:';
  98.   picklist[19]:=' 1';
  99.   picklist[20]:='21';
  100.   picklist[21]:='41';
  101.   picklist[22]:='61';
  102.   title4:=18;
  103.   items4:=4;
  104.   cl:=1;
  105.   picklist[23]:='Decimal Places:';
  106.   picklist[24]:=' 0';
  107.   picklist[25]:=' 1';
  108.   picklist[26]:=' 2';
  109.   picklist[27]:=' 3';
  110.   picklist[28]:=' 4';
  111.   picklist[29]:=' 5';
  112.   title5:=23;
  113.   items5:=6;
  114.   dp:=1;
  115.   picklist[30]:='Zero Input:';
  116.   picklist[31]:='Accepted';
  117.   picklist[32]:='Rejected';
  118.   title6:=30;
  119.   items6:=2;
  120.   zv:=1;
  121.   picklist[33]:='Rows:';
  122.   picklist[34]:='21';
  123.   picklist[35]:='22';
  124.   picklist[36]:='23';
  125.   picklist[37]:='24';
  126.   title7:=33;
  127.   items7:=4;
  128.   rw:=2;
  129.   picklist[38]:='Field Length:';
  130.   picklist[39]:=' 1';
  131.   picklist[40]:=' 2';
  132.   picklist[41]:=' 3';
  133.   picklist[42]:=' 4';
  134.   picklist[43]:=' 5';
  135.   picklist[44]:=' 6';
  136.   picklist[45]:=' 7';
  137.   picklist[46]:=' 8';
  138.   picklist[47]:=' 9';
  139.   picklist[48]:='10';
  140.   title8:=38;
  141.   items8:=10;
  142.   fl:=6;
  143.   picklist[49]:='Hi Text Color';
  144.   picklist[50]:='White';
  145.   picklist[51]:='Yellow';
  146.   picklist[52]:='Magenta';
  147.   picklist[53]:='Red';
  148.   picklist[54]:='Cyan';
  149.   picklist[55]:='Green';
  150.   picklist[56]:='Blue';
  151.   title9:=49;
  152.   items9:=7;
  153.   hitc:=2;
  154.   picklist[57]:='Lo Text Color';
  155.   picklist[58]:='White';
  156.   picklist[59]:='Brown';
  157.   picklist[60]:='Magenta';
  158.   picklist[61]:='Red';
  159.   picklist[62]:='Cyan';
  160.   picklist[63]:='Green';
  161.   picklist[64]:='Blue';
  162.   title10:=57;
  163.   items10:=7;
  164.   lotc:=1;
  165.  
  166.   { Initialize buffers }
  167.   strbuf:='';
  168.   intbuf:=0;
  169.   decbuf:=0;
  170.  
  171.   Repeat
  172.  
  173.     { Write pick lists }
  174.     writepicklist(1,1,items1,title1);
  175.     writepicklist(1,5,items2,title2);
  176.     writepicklist(1,17,items3,title3);
  177.     writepicklist(24,3,items4,title4);
  178.     writepicklist(24,9,items5,title5);
  179.     writepicklist(24,17,items6,title6);
  180.     writepicklist(43,3,items7,title7);
  181.     writepicklist(43,9,items8,title8);
  182.     writepicklist(62,3,items9,title9);
  183.     writepicklist(62,12,items10,title10);
  184.  
  185.     { Step through fields }
  186.     maxfldnum:=11;
  187.     fldnum:=1;
  188.     firstpass:=True;
  189.  
  190.     Repeat { Until screen accepted or canceled }
  191.  
  192.       Repeat { Until data entry or editing completed }
  193.  
  194.         { Execute the next field function }
  195.         Case fldnum Of
  196.  
  197.           1: Begin
  198.                keyreturn:=getpick(1,2,items1,rv,picklist[title1+1]);
  199.                If rv =1 Then reversevideo:=True
  200.                Else reversevideo:=False
  201.              End;
  202.           2: Begin
  203.                keyreturn:=getpick(1,6,items2,ft,picklist[title2+1]);
  204.                If ft = 1 Then fldtype:=alsymb;
  205.                If ft = 2 Then fldtype:=ascii;
  206.                If ft = 3 Then fldtype:=caplet;
  207.                If ft = 4 Then fldtype:=digits;
  208.                If ft = 5 Then fldtype:=usnint;
  209.                If ft = 6 Then fldtype:=sgnint;
  210.                If ft = 7 Then fldtype:=usndec;
  211.                If ft = 8 Then fldtype:=sgndec;
  212.                If ft = 9 Then fldtype:=usnufd;
  213.                If ft = 10 Then fldtype:=sgnufd
  214.              End;
  215.           3: Begin
  216.                keyreturn:=getpick(1,18,items3,rq,picklist[title3+1]);
  217.                If rq =1 Then required:=False
  218.                Else required:=True
  219.              End;
  220.           4: Begin
  221.                keyreturn:=getpick(24,4,items4,cl,picklist[title4+1]);
  222.                If cl = 1 Then col:=1;
  223.                If cl = 2 Then col:=21;
  224.                If cl = 3 Then col:=41;
  225.                If cl = 4 Then col:=61
  226.              End;
  227.           5: Begin
  228.                keyreturn:=getpick(24,10,items5,dp,picklist[title5+1]);
  229.                decpla:=dp-1
  230.              End;
  231.           6: Begin
  232.                keyreturn:=getpick(24,18,items6,zv,picklist[title6+1]);
  233.                If zv = 1 Then zerovoid:=False
  234.                Else zerovoid:=True
  235.              End;
  236.           7: Begin
  237.                keyreturn:=getpick(43,4,items7,rw,picklist[title7+1]);
  238.                row:=rw+20
  239.              End;
  240.           8: Begin
  241.                keyreturn:=getpick(43,10,items8,fl,picklist[title8+1]);
  242.                len:=fl
  243.              End;
  244.           9: Begin
  245.                keyreturn:=getpick(62,4,items9,hitc,picklist[title9+1]);
  246.                If hitc = 1 Then hitxtcolor:=White;
  247.                If hitc = 2 Then hitxtcolor:=Yellow;
  248.                If hitc = 3 Then hitxtcolor:=LightMagenta;
  249.                If hitc = 4 Then hitxtcolor:=LightRed;
  250.                If hitc = 5 Then hitxtcolor:=LightCyan;
  251.                If hitc = 6 Then hitxtcolor:=LightGreen;
  252.                If hitc = 7 Then hitxtcolor:=LightBlue
  253.              End;
  254.          10: Begin
  255.                keyreturn:=getpick(62,13,items10,lotc,picklist[title10+1]);
  256.                If lotc = 1 Then lotxtcolor:=LightGray;
  257.                If lotc = 2 Then lotxtcolor:=Brown;
  258.                If lotc = 3 Then lotxtcolor:=Magenta;
  259.                If lotc = 4 Then lotxtcolor:=Red;
  260.                If lotc = 5 Then lotxtcolor:=Cyan;
  261.                If lotc = 6 Then lotxtcolor:=Green;
  262.                If lotc = 7 Then lotxtcolor:=Blue
  263.              End;
  264.          11: Begin
  265.                noteactive:=False;
  266.                If fldtype < usnint Then
  267.                  keyreturn:=editfield
  268.                             (col,row,len,decpla,fldtype,required,strbuf)
  269.                Else If fldtype < usndec Then
  270.                  keyreturn:=editfield(col,row,len,decpla,fldtype,required,intbuf)
  271.                Else
  272.                  keyreturn:=editfield(col,row,len,decpla,fldtype,required,decbuf)
  273.              End;
  274.           Else
  275.         End;  { fldnum Case statement }
  276.  
  277.         { Select the next fldnum based on keyreturn }
  278.         Case keyreturn Of
  279.           enterkey:
  280.               If fldnum < maxfldnum
  281.               Then inc(fldnum)
  282.               Else fldnum:=0;
  283.           uparrowkey:
  284.               fldnum:=nextfldnum[fldnum,up];
  285.           dnarrowkey:
  286.               fldnum:=nextfldnum[fldnum,down];
  287.           tabkey:
  288.               fldnum:=nextfldnum[fldnum,right];
  289.           shiftabkey:
  290.               fldnum:=nextfldnum[fldnum,left];
  291.           esckey:
  292.               If firstpass
  293.               Then Write(char(7))
  294.               Else If fldnum = 11
  295.               Then fldnum:=0
  296.               Else fldnum:=11;
  297.           Else
  298.         End;  { keyreturn Case statement}
  299.  
  300.       Until fldnum = 0; { Data entry or editing completed }
  301.  
  302.       note('HOME to Restart, ENTER to Edit, ESC to exit!');
  303.       Repeat
  304.         keyreturn:=getspecialkey;
  305.         If (keyreturn <> homekey) And
  306.            (keyreturn <> enterkey) And
  307.            (keyreturn <> esckey)
  308.         Then
  309.           errmsg('Must be HOME (Restart), ENTER (Edit), Or ESC (Exit)!');
  310.       Until
  311.            (keyreturn = enterkey) Or
  312.            (keyreturn = homekey) Or
  313.            (keyreturn = esckey);
  314.       If keyreturn = enterkey Then
  315.         Begin
  316.           note('Use '#24', '#25', TAB, and Shft-TAB keys to select field; ESC to Exit');
  317.           firstpass:=false;
  318.           fldnum:=1
  319.         End;
  320.  
  321.     Until
  322.          (keyreturn = homekey) Or { Screen restart }
  323.          (keyreturn = esckey);    { Screen cancled }
  324.     If keyreturn = homekey Then
  325.       Begin
  326.         noteactive:=False;
  327.         col:=1;
  328.         For row:=21 To 24 Do
  329.           Begin
  330.             GotoXY(col,row);
  331.             ClrEol
  332.           End
  333.       End;
  334.   Until keyreturn = esckey;
  335.   cursor(underline); { cursor on }
  336.   NormVideo;
  337. End.  { Demo Program }
  338.