Tworzenie książki adresowej z wykorzystaniem komponentów BDE

Poniższy kod zawiera podstawową obsłgę baz danych na przykładzie książki telefonicznej. Można go rozbudować o wyszukiwanie oraz usuwanie rekordów. Zawiera natomiast tworzenie bazy wraz z indeksem, przechodzenie do rekordu poprzedniego oraz do rekordku następnego.

Oto kod:

unit bde_unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, DBTables;

type
  TForm1 = class(TForm)
    Table1: TTable;
    Label1: TLabel;
    Label2: TLabel;
    lbl_nr_rekordu: TLabel;
    Edit_nazwisko: TEdit;
    Edit_imie: TEdit;
    Edit_nr_tel: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label3: TLabel;
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure tworz_baze();
  private
    { Private declarations }
    sc_programu : string;
    il_rek : integer;
    nr_rek : integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
  sc_programu:=ExtractFilePath(ParamStr(0));

  edit_imie.Text := '';
  edit_nazwisko.Text := '';
  edit_nr_tel.Text := '';
  nr_rek := 0;
  lbl_nr_rekordu.Caption := '';

  //tworzenie katalogu dla pliku z bazą danych
  if not directoryexists(sc_programu + 'baza\') then
  begin
    chdir(pchar(sc_programu));
    mkdir(pchar('baza'));
    chdir(pchar(sc_programu));
  end;

  // ścieżka do bazy danych
  Table1.DatabaseName := sc_programu + 'baza\';
  // ustawienie nazwy bazy
  Table1.TableName := 'tbl_telefony.dbf';
  // sprawdzenie istnienia pliku z baza danych
  if not fileexists (sc_programu + 'baza\tbl_telefony.dbf') then
  begin
    tworz_baze();
  end;

  if (fileexists (sc_programu + 'baza\tbl_telefony.dbf')) and (not table1.Active) then
  begin
    //Aktywacja tabeli
    table1.Active := true;
    edit_imie.Text := '';
    edit_nazwisko.Text := '';
    edit_nr_tel.Text := '';
    nr_rek := 0;
  end;

  if table1.Active then
  begin
    if table1.RecordCount > 0 then
    begin
      il_rek := table1.RecordCount;
      table1.First;
      lbl_nr_rekordu.Caption := '1 / ' + inttostr(il_rek);
      nr_rek := 1;
      //wstawianie wartości do kontrolek edit
      edit_nazwisko.Text := table1.FieldByName('Nazwisko').Value;
      edit_imie.Text := table1.FieldByName('Imie').Value;
      edit_nr_tel.Text := table1.FieldByName('Telefon').Value;
    end;
    if table1.RecordCount <= 0 then
    begin
      il_rek := 0;
      nr_rek := 0;
      lbl_nr_rekordu.Caption := '0 / ' + inttostr(il_rek);
    end;
  end;

end;

procedure TForm1.tworz_baze();
begin
  //procedura tworząca bazę danych telefony
  with Table1 do
  begin
    Active := False;
    TableType := ttDBase;
    with FieldDefs do
    begin
      Clear;
      Add('NR', ftString, 10, true);
      Add('Nazwisko', ftString, 200, false);
      Add('Imie', ftString, 200, false);
      Add('Telefon', ftString, 50, false);
    end;
    // indeksy bazy danych
    with IndexDefs do
    begin
      Clear;
      Add('', 'NR', [ixPrimary, ixUnique]);
    end;
  end;

  //utworzenie tabeli
  Table1.CreateTable;
  //otwarcie tabeli
  Table1.Open;

  if Table1.Active then
  begin
    //jeżeli tabela jest aktywna
    //dezaktywacja tabeli
    Table1.Active := false;
  end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if table1.Active then
  begin
    table1.Active := false;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  //dodawanie rekordu do tabeli
  if table1.Active then
  begin
    if (edit_imie.Text <> '') and (edit_nazwisko.Text <> '') and (edit_nr_tel.Text <> '') then
    begin
      il_rek := il_rek + 1;
      nr_rek := il_rek;
      table1.InsertRecord([inttostr(il_rek), edit_nazwisko.Text, edit_imie.Text, edit_nr_tel.Text]);
      table1.Edit;
      table1.Post;
      table1.Last;
      lbl_nr_rekordu.Caption := inttostr(il_rek) + ' / ' + inttostr(il_rek);
    end;
    if (edit_imie.Text = '') or (edit_nazwisko.Text = '') or (edit_nr_tel.Text = '') then
    begin
      showmessage('Jedno z pól nie jest wypełnione, dodanie nie jest możliwe !!!');
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //przejście do rekordu poprzedniego
  if (table1.Active) and (table1.RecNo > 1) then
  begin
    table1.Prior;
    nr_rek := nr_rek - 1;
    edit_nazwisko.Text := table1.FieldByName('Nazwisko').Value;
    edit_imie.Text := table1.FieldByName('Imie').Value;
    edit_nr_tel.Text := table1.FieldByName('Telefon').Value;
    lbl_nr_rekordu.Caption := inttostr(nr_rek) + ' / ' + inttostr(il_rek);
  end;
  if (table1.Active) and (table1.RecNo <= 1) then
  begin
    showmessage('To jest piewrszy rekord !!!');
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  //przejście do rekordu następnego
  if (table1.Active) and (table1.RecNo < il_rek) then
  begin
    table1.Next;
    nr_rek := nr_rek + 1;
    edit_nazwisko.Text := table1.FieldByName('Nazwisko').Value;
    edit_imie.Text := table1.FieldByName('Imie').Value;
    edit_nr_tel.Text := table1.FieldByName('Telefon').Value;
    lbl_nr_rekordu.Caption := inttostr(nr_rek) + ' / ' + inttostr(il_rek);
  end;
  if (table1.Active) and (table1.RecNo >= il_rek) then
  begin
    showmessage('To jest ostatni rekord !!!');
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  application.Terminate;
end;

end.