home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPDB13.ZIP / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-02-13  |  4.9 KB  |  187 lines
  1. {$A+,B+,D-,E+,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3.  
  4. Program Demo;
  5.  
  6. Uses Crt,Dos,TPDB;
  7.  
  8. {Demonstrates the use of TPDB to append, search, and edit a dBASE
  9.  file from a Turbo Pascal program.}
  10.  
  11. Var
  12.     SPos : Byte;
  13.  
  14.      Procedure SetUp;
  15.      begin
  16.              DBOpenFile('demo.dbf');
  17.           Normal := White+BlueBG;
  18.           Reverse := Black+LightGrayBG;
  19.           SetColor(White,Blue);
  20.              ClrScr;
  21.              SetColor(Black,LightGray);
  22.      end;
  23.  
  24.      Procedure GetInput;
  25.      Var
  26.         Continue : String[1];
  27.      begin
  28.           Block;
  29.           Repeat
  30.           Continue := #0;
  31.           NewDBRec;
  32.           Prompt(2,5,'Enter Last Name: ');
  33.           Say(1,2,22);
  34.           Prompt(4,5,'Enter Address: ');
  35.           Say(2,4,22);
  36.           Prompt(6,5,'Enter City: ');
  37.              Say(3,6,17);
  38.           Prompt(8,5,'Enter State: ');
  39.           Say(4,8,19);
  40.           Prompt(10,5,'Enter ZIP: ');
  41.           Say(5,10,16);
  42.           Prompt(12,5,'Enter an Integer: ');
  43.           Say(6,12,24);
  44.           Prompt(14,5,'Enter a Real number: ');
  45.           Say(7,14,27);
  46.           Prompt(16,5,'Enter a Date: ');
  47.           Say(8,16,20);
  48.           Prompt(18,5,'Enter Y or N: ');
  49.           Say(9,18,20);
  50.           GotoXY(5,20);
  51.           Write('Press the Escape key when finished.');
  52.  
  53.           SPos := 1;
  54.  
  55.           Repeat
  56.           Case SPos of
  57.           1 : Get(1,2,22);
  58.           2 : Get(2,4,22);
  59.              3 : Get(3,6,17);
  60.           4 : Get(4,8,19);
  61.           5 : Get(5,10,16);
  62.           6 : Get(6,12,24);
  63.           7 : Get(7,14,27);
  64.           8 : Get(8,16,20);
  65.           9 : Get(9,18,20);
  66.           end;
  67.           CheckScreen(SPos,BC,Up,Down,1,9);
  68.           Until BC in Next;
  69.           AddDBRec;
  70.           Prompt(22,5,'Add another record ? (Y or N)');
  71.           BC := GetString(Continue,1,36,22);
  72.           SetColor(Blue,Blue);
  73.           GotoXY(5,22);
  74.           ClrEol;
  75.           SetColor(Black,LightGray);
  76.           Continue := Upper(Continue);
  77.           Until Continue = 'N';
  78.      end;
  79.  
  80.      Procedure Index;
  81.      begin
  82.           SetColor(White,Blue);
  83.           ClrScr;
  84.           Writeln('Building an index on the NAME field: ');
  85.           UCKey := True; {Convert each key string to upper case}
  86.           BuildIndex('demo.ndx',1,30,Duplicates);
  87.      end;
  88.  
  89.      Procedure SeekRecord;
  90.      Var
  91.         LastName : String[30];
  92.      begin
  93.              OpenDBIndex('demo.ndx',30,Duplicates);
  94.           Repeat
  95.           LastName := '';
  96.           ClrScr;
  97.           Prompt(5,5,'Enter Last Name to Find: ');
  98.           Prompt(7,5,'Press Escape to Quit.');
  99.           BC := GetString(LastName,30,30,5);
  100.           If BC = #27 then Exit;
  101.           Find(LastName);
  102.           If not Found then Find(Upper(LastName));
  103.           If Found then
  104.           begin
  105.           ClrScr;
  106.           FlashFill(1,1,25,80,Blue+BlackBG,#176);
  107.           Prompt(2,5,'Enter Last Name: ');
  108.           Say(1,2,22);
  109.           Prompt(4,5,'Enter Address: ');
  110.           Say(2,4,22);
  111.           Prompt(6,5,'Enter City: ');
  112.           Say(3,6,16);
  113.           Prompt(8,5,'Enter State: ');
  114.           Say(4,8,19);
  115.           Prompt(10,5,'Enter ZIP: ');
  116.           Say(5,10,16);
  117.           Prompt(12,5,'Enter an Integer: ');
  118.           Say(6,12,24);
  119.           Prompt(14,5,'Enter a Real number: ');
  120.           Say(7,14,27);
  121.           Prompt(16,5,'Enter a Date: ');
  122.           Say(8,16,20);
  123.           Prompt(18,5,'Enter Y or N: ');
  124.           Say(9,18,20);
  125.           GotoXY(5,20);
  126.           Write('Press the Escape key when finished.');
  127.  
  128.  
  129.           SPos := 1;
  130.  
  131.           Repeat
  132.           Case SPos of
  133.           1 : Get(1,2,22);
  134.           2 : Get(2,4,22);
  135.           3 : Get(3,6,16);
  136.           4 : Get(4,8,19);
  137.           5 : Get(5,10,16);
  138.           6 : Get(6,12,24);
  139.           7 : Get(7,14,27);
  140.           8 : Get(8,16,20);
  141.           9 : Get(9,18,20);
  142.           end;
  143.           CheckScreen(SPos,BC,Up,Down,1,9);
  144.           Until BC in Next;
  145.           end
  146.           else
  147.           begin
  148.           Writeln;
  149.           Writeln(#7);
  150.           Prompt(6,15,'NAME NOT FOUND !');
  151.           Wait;
  152.           end;
  153.           Until BC = #27;
  154.      end;
  155.  
  156.      Procedure CloseOut;
  157.      begin
  158.           CloseDBFile;
  159.           CloseDBIndex;
  160.           ClrScr;
  161.           FlashFill(1,1,25,80,Blue+BlackBG,#177);
  162.           FlashC(10,White+RedBG,'TPDB Version 1.3');
  163.           FlashC(12,White+RedBG,'By Brian Corll');
  164.           FlashC(14,White+RedBG,'Copyright 1989');
  165.           Repeat Until KeyPressed;
  166.           ClrScr;
  167.      end;
  168.  
  169.      Procedure ErrorDemo;
  170.      begin
  171.              OpenDBIndex('demo.ndx',50,Duplicates);
  172.      end;
  173.  
  174. begin
  175.  
  176.      {Bracket out these routines and substitute ErrorDemo for
  177.       a demonstration of the TPDB error handler.  In this case,
  178.       the wrong field length is specified as the KeyLen in the
  179.       call to ErrorDemo.}
  180.  
  181.       SetUp;
  182.      GetInput;
  183.      Index;
  184.      SeekRecord;
  185.       CloseOut;
  186.       {ErrorDemo;}
  187. end.