BDE - obługa pola ftGraphic, ftBlob

Obsługa pola ftBlob, ftGraphic w BDE, czyli jak dodać do bazy zawartość dowolnego pliku.

Na formie umieszczamy komponent z zakładki BDE
- TTable
Dodajemy też TButton, TListView (zmieniamy własciwość ViewStyle na vsReport i dodajemy jedną kolumnę nazywając ją 'plik'), TOpenDialog1, TSaveDialog1.

1) Piszemy procedurkę tworzącą tabelę:

 
procedure TForm1.tworz_baze();
begin
  table1.DatabaseName := sc_programu;
  table1.TableName := 'tabela.dbf';
  if not fileexists(sc_programu + table1.TableName) then
  begin
    showmessage('Tworzenie bazy: ' + table1.TableName);
    chdir(pchar(sc_programu));
    with table1 do
    begin
      if Active = true then
      begin
        Active := false;
      end;
      TableType := ttDBase;
      // pola bazy danych
      with FieldDefs do
      begin
        Clear;
        Add('plik', ftString, 1000, False);
        Add('zal', ftGraphic); //można uzyć tutaj ftBlob
      end;
    end;
    //tworzenie bazy danych
    table1.CreateTable;
    chdir(pchar(sc_programu));
  end;
  if fileexists(sc_programu + table1.TableName) then
  begin
    if not table1.Active then
    begin
      table1.Active := true;
    end;
  end;
end;

2) Piszemy procedurę FormCreate:

 
procedure TForm1.FormCreate(Sender: TObject);
begin
   sc_programu:=ExtractFilePath(ParamStr(0));
   tworz_baze();
   pokaz_rek();
end;

3) Piszemy procedurę pokaz_rek:

 
procedure TForm1.pokaz_rek();
var
  List : TListItem;
begin
  if not table1.Active then
  begin
    table1.Active := true;
  end;
  ListView1.Clear;
  table1.First;
  while not table1.Eof do
  begin
    if table1.FieldByName('plik').Value <> Null then
    begin
      list := ListView1.Items.Add;
      List.Caption := table1.FieldByName('plik').Value;
    end;
    table1.Next;
  end;
  if table1.Active then
  begin
    table1.Active := false;
  end;
end;

4) Dodajemy obsługę zdarzenia OnClick przycisku Button1:

 
procedure TForm1.Button1Click(Sender: TObject);
var
  blob, myFileStream : TStream;
begin
  if OpenDialog1.Execute then
  begin
    if table1.Active then
    begin
      table1.Active := false;
    end;
    if not table1.Active then
    begin
      table1.Active := true;
    end;
 
    table1.InsertRecord([OpenDialog1.FileName]);
    table1.Edit;
    Blob := table1.CreateBlobStream(table1.FieldByName('zal'), bmWrite);
    try
      blob.Seek(0, soFromBeginning);
      myFileStream := TFileStream.Create(OpenDialog1.FileName, fmShareDenyWrite);
      try
        blob.CopyFrom(myFileStream, myFileStream.Size) ;
      finally
        myFileStream.Free ;
      end;
    finally
      blob.Free ;
    end;
    table1.Post;
 
    if table1.Active then
    begin
      table1.Active := false;
    end;
  end;
  pokaz_rek();
end;

5) Dodajemy obsługę zdarzenia OnDblClick komponentu ListView1:

 
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  blob, myFileStream : TStream;
  plik : string;
begin
  table1.Active := true;
  plik := ListView1.Selected.Caption;
  table1.First;
  while not table1.Eof do
  begin
    if table1.FieldByName('plik').Value = plik then
    begin
      savedialog1.FileName := plik;
      if savedialog1.Execute then
      begin
        blob := table1.CreateBlobStream(table1.FieldByName('zal'), bmRead);
        try
          blob.Seek(0, soFromBeginning);
          myFileStream := TFileStream.Create(SaveDialog1.FileName, fmCreate);
          try
            myFileStream.CopyFrom(blob, blob.Size) ;
          finally
            myFileStream.Free ;
          end;
        finally
          blob.Free ;
        end;
      end;
      break;
    end;
    table1.Next;
  end;
end;

Kod źródłowy:

 
unit test_unit;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Forms, ExtCtrls, ShellAPI, Dialogs, DB, DBTables, StdCtrls, ComCtrls,
  DBClient, Provider, Grids, DBGrids, DBCtrls;
 
type
  TForm1 = class(TForm)
    table1: TTable;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    SaveDialog1: TSaveDialog;
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure tworz_baze();
    procedure pokaz_rek();
    procedure Button1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
  private
    { Private declarations }
    sc_programu : string;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
  blob, myFileStream : TStream;
begin
  if OpenDialog1.Execute then
  begin
    if table1.Active then
    begin
      table1.Active := false;
    end;
    if not table1.Active then
    begin
      table1.Active := true;
    end;
    table1.InsertRecord([OpenDialog1.FileName]);
    table1.Edit;
    Blob := table1.CreateBlobStream(table1.FieldByName('zal'), bmWrite);
    try
      blob.Seek(0, soFromBeginning);
      myFileStream := TFileStream.Create(OpenDialog1.FileName, fmShareDenyWrite);
      try
        blob.CopyFrom(myFileStream, myFileStream.Size) ;
      finally
        myFileStream.Free ;
      end;
    finally
      blob.Free ;
    end;
    table1.Post;
    if table1.Active then
    begin
      table1.Active := false;
    end;
  end;
  pokaz_rek();
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  sc_programu:=ExtractFilePath(ParamStr(0));
  tworz_baze();
  pokaz_rek();
end;
 
procedure TForm1.pokaz_rek();
var
  List : TListItem;
begin
  if not table1.Active then
  begin
    table1.Active := true;
  end;
  ListView1.Clear;
  table1.First;
  while not table1.Eof do
  begin
    if table1.FieldByName('plik').Value <> Null then
    begin
      list := ListView1.Items.Add;
      List.Caption := table1.FieldByName('plik').Value;
    end;
    table1.Next;
  end;
  if table1.Active then
  begin
    table1.Active := false;
  end;
end;
 
procedure TForm1.ListView1DblClick(Sender: TObject);
var
  blob, myFileStream : TStream;
  plik : string;
begin
  table1.Active := true;
  plik := ListView1.Selected.Caption;
  table1.First;
  while not table1.Eof do
  begin
    if table1.FieldByName('plik').Value = plik then
    begin
      savedialog1.FileName := plik;
      if savedialog1.Execute then
      begin
        blob := table1.CreateBlobStream(table1.FieldByName('zal'), bmRead);
        try
          blob.Seek(0, soFromBeginning);
          myFileStream := TFileStream.Create(SaveDialog1.FileName, fmCreate);
          try
            myFileStream.CopyFrom(blob, blob.Size) ;
          finally
            myFileStream.Free ;
          end;
        finally
          blob.Free ;
        end;
      end;
      break;
    end;
    table1.Next;
  end;
end;
 
procedure TForm1.tworz_baze();
begin
  table1.DatabaseName := sc_programu;
  table1.TableName := 'tabela.dbf';
  if not fileexists(sc_programu + table1.TableName) then
  begin
    showmessage('Tworzenie bazy: ' + table1.TableName);
    chdir(pchar(sc_programu));
    with table1 do
    begin
      if Active = true then
      begin
        Active := false;
      end;
      TableType := ttDBase;
      with FieldDefs do
      begin
        Clear;
        Add('plik', ftString, 1000, False);
        Add('zal', ftGraphic);  //można użyć ftBlob
      end;
    end;
    table1.CreateTable;
    chdir(pchar(sc_programu));
  end;
  if fileexists(sc_programu + table1.TableName) then
  begin
    if not table1.Active then
    begin
      table1.Active := true;
    end;
  end;
end;
 
end.

Kategoria: Delphi » Gotowce

BDE - obługa pola ftGraphic, ftBlob

Programowanie

Forum dyskusyjne

4programmers.net

O nas