home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 November / Chip_2002-11_cd1.bin / zkuste / delphi / kompon / d123456 / JBDBF.ZIP / TESTDBF1.PAS < prev   
Pascal/Delphi Source File  |  2001-12-05  |  4KB  |  156 lines
  1. unit Testdbf1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, jbDbf, Gauges, ExtCtrls, jbEdit, FileCtrl;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     DBF1: TjbDBF;
  13.     Button2: TButton;
  14.     Button3: TButton;
  15.     Edit1: TPubEdit;
  16.     Panel1: TPanel;
  17.     Panel2: TPanel;
  18.     Panel3: TPanel;
  19.     Gauge1: TGauge;
  20.     Label1: TLabel;
  21.     ListBox1: TListBox;
  22.     RadioButton1: TRadioButton;
  23.     RadioButton2: TRadioButton;
  24.     Edit2: TEdit;
  25.     Label2: TLabel;
  26.     Bevel1: TBevel;
  27.     procedure Button1Click(Sender: TObject);
  28.     procedure Button2Click(Sender: TObject);
  29.     procedure Button3Click(Sender: TObject);
  30.     procedure DBF1Found(Sender: TObject);
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure DBF1Progress(Sender: TObject; const Operace: ShortString;
  33.       Progress: Integer);
  34.     procedure DBF1Query(Sender: TObject; const IdxName, IdxField,
  35.       Key: ShortString; var Accept, Cancel: Boolean);
  36.   private
  37.     { Private declarations }
  38.     N:Integer;
  39.   public
  40.     { Public declarations }
  41.   end;
  42.  
  43. var
  44.   Form1: TForm1;
  45.  
  46. implementation
  47.  
  48. {$R *.DFM}
  49.  
  50. procedure TForm1.Button1Click(Sender: TObject);
  51. begin
  52.   Close
  53. end;
  54.  
  55. Const
  56.   jmspoub='test_y.dbf';
  57.  
  58. procedure TForm1.Button2Click(Sender: TObject);
  59. Var
  60.   I:Integer;
  61. begin
  62.   {zrus predchozi}
  63.   SysUtils.DeleteFile(Edit2.Text+'test_y.dbf');
  64.   SysUtils.DeleteFile(Edit2.Text+'cislo.idx');
  65.   SysUtils.DeleteFile(Edit2.Text+'test.idx');
  66.   {vyrob novou tabulku s indexy}
  67.   With DBF1 Do Begin
  68.     MakeField(1,'cislo','n',10,0,'cislo.idx',dbfUnique,dbfDescending);
  69.     MakeField(2,'test','c',50,0,'test.idx',dbfDuplicates,dbfAscending);
  70.     CreateDB(Edit2.Text+jmspoub,10+50,2);
  71.     FileName := Edit2.Text+jmspoub;
  72.     {make some fields}
  73.     If Open Then Begin
  74.       For I := 1 To 100 Do Begin
  75.         Store('cislo',IntToStr(I));
  76.         Store('test','Ahojky '+IntToStr(I));
  77.         NewRecord;
  78.       End;
  79.       {preindexuj}
  80.       Reindex;
  81.       {RemoveIndexes(1);}
  82.       Gauge1.Progress:=0;
  83.       Panel2.Caption:='';
  84.       Close;
  85.       Button3.Enabled:=True;
  86.     End;
  87.   End;
  88. end;
  89.  
  90. procedure TForm1.Button3Click(Sender: TObject);
  91. begin
  92.   N:=0;
  93.   {find proc}
  94.   With DBF1 Do Begin
  95.     FileName:=Edit2.Text+jmspoub;
  96.     If Open Then Begin
  97.       Find('cislo.idx','cislo'); {hledej pres Found+Query}
  98.       Gauge1.Progress:=0;
  99.       Panel2.Caption:='';
  100.       Close
  101.     End;
  102.   End;
  103. end;
  104.  
  105. procedure TForm1.DBF1Found(Sender: TObject);
  106. begin
  107.   //find
  108.   {standardni hlasky}
  109.   If Radiobutton1.Checked Then Begin
  110.     Label1.Caption:='Found ('+DBF1.Load('cislo')+'):';
  111.     Edit1.Text:=DBF1.Load('test');
  112.   End
  113.   Else Begin
  114.     Inc(N);
  115.     Label1.Caption:='Found '+IntToStr(N)+' fields:';
  116.     ListBox1.Items.Add(DBF1.Load('cislo')+' -- '+DBF1.Load('test'));
  117.   end;
  118. end;
  119.  
  120. procedure TForm1.FormCreate(Sender: TObject);
  121. begin
  122.   Edit2.Text := 'c:\_testdbf\';{toto je cesta k souboru}
  123.   //make directory when doesn't exists
  124.   ForceDirectories(Edit2.Text);
  125.   Edit1.Text := '';
  126.   Label1.Caption:='';
  127.   N:=0;
  128.   ListBox1.Clear;
  129. end;
  130.  
  131. procedure TForm1.DBF1Progress(Sender: TObject; const Operace: ShortString;
  132.   Progress: Integer);
  133. begin
  134.   Gauge1.Progress:=Progress;
  135.   Panel2.Caption:=Operace;
  136.   Application.ProcessMessages
  137. end;
  138.  
  139. procedure TForm1.DBF1Query(Sender: TObject; const IdxName, IdxField,
  140.   Key: ShortString; var Accept, Cancel: Boolean);
  141. begin
  142.   {zde realizace dotazu a accept/cancel}
  143.   If Key<>'' Then
  144.     If Radiobutton1.Checked Then Begin
  145.       If StrToInt(Key)=42 Then Begin
  146.         Accept:=True; {tento si vezmi}
  147.         Cancel:=True; {ale dalsi jiz odmitni}
  148.       End;
  149.     End
  150.     Else Begin
  151.       If (StrToInt(Key)>44) And (StrToInt(Key)<56) Then Accept:=True;
  152.     End;
  153. end;
  154.  
  155. end.
  156.