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