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