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