BDE - obługa pola ftGraphic, ftBlob
rk7771
Obsługa pola ftBlob, ftGraphic w BDE, czyli jak dodać do bazy zawartość dowolnego pliku.
Na formie umieszczamy komponent z zakładki <font color="navy">BDE</span>
- 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;
<font color="navy">Kod źródłowy:</span>
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.