首页
IT
登录
6mi
u
盘
搜
搜 索
IT
DELPHI存取JPEG、BMP图像到数据库完整解决方案
DELPHI存取JPEG、BMP图像到数据库完整解决方案
xiaoxiao
2025-10-25
9
程序代码如下所示:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ExtDlgs, StdCtrls, ADODB, Grids, DBGrids, ExtCtrls,jpeg,
DBCtrls;
type
TForm1 = class(TForm)
DBGrid1: TDBGrid;
ADOConnection1: TADOConnection;
ADOTable1: TADOTable;
selectimage: TButton;
savetodb: TButton;
OpenPictureDialog1: TOpenPictureDialog;
DataSource1: TDataSource;
DBNavigator1: TDBNavigator;
savetofile: TButton;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Bevel1: TBevel;
Bevel2: TBevel;
GroupBox1: TGroupBox;
Image1: TImage;
Label3: TLabel;
Label4: TLabel;
DBImage1: TDBImage;
procedure selectimageClick(Sender: TObject);
procedure savetodbClick(Sender: TObject);
procedure ADOTable1AfterScroll(DataSet: TDataSet);
procedure savetofileClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ADOTable1BeforeScroll(DataSet: TDataSet);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses unit2;
{$R *.dfm}
procedure TForm1.selectimageClick(Sender: TObject);
//选择图像
begin
if openpicturedialog1.Execute then
image1.Picture.LoadFromFile(openpicturedialog1.FileName );
end;
如下保存方法only to sql and access'data
procedure TForm1.savetodbClick(Sender: TObject);
//保存图像
var
strm:tmemorystream;
ext:string;
begin
if image1.picture.Graphic <> nil then
//避免image1中无图像保存出错
begin
ext:=extractfileext(openpicturedialog1.FileName );
strm := tmemorystream.Create ;
try
image1.Picture.Graphic.SaveToStream(strm);
adotable1.Edit ;
strm.Position :=0;
DBImage1.dataField :='';
//dbimage只能显示BMP,否则myimage由BMP变为jpeg时会出错
tblobfield(adotable1.FieldByName('myimage')).LoadFromStream(strm);
//如需直接由文件保存 TBlobField(adotable1.FieldByName('myimage')).LoadFromFile (OpenPictureDialog1.FileName);
//以下记录保存到数据库的图像格式
if uppercase(ext) = '.BMP' then
begin
adotable1.FieldByName('isbmp').Value := 1;
dbimage1.dataField := 'myimage';
end
else if (uppercase(ext) = '.JPG') OR ( uppercase(ext) = '.JPEG') THEN
adotable1.FieldByName('isbmp').Value := 0;
adotable1.Post ;
finally
strm.Free ;
//如果你选用TBLOBSTREAM类,程序运行到此语句会出错,可该语句前添入adotable1.edit
end;
end;
end;
///如下显示方法不适用于paradox中的graphic字段的显示。
procedure TForm1.adoTable1AfterScroll(DataSet: TDataSet);
//显示图像
var
strm:tadoblobstream;
jpegimage:tjpegimage;
bitmap:tbitmap;
begin
strm := tadoblobstream.Create(tblobfield(adotable1.fieldbyname('MYIMAGE')),bmread);
try
//try1
strm.position :=0;
image1.Picture.Graphic := nil;
DBIMAGE1.DataField := '';
//显示时,BMP、JPEG两种图像数据必需分别处理
if adotable1.fieldbyname('isbmp').asstring ='1' then
begin
//begin11
bitmap := tbitmap.Create ;
try
//try11
bitmap.LoadFromStream(strm);
image1.Picture.Graphic := bitmap;
DBIMAGE1.DataField := 'myimage';
finally
bitmap.Free;
end;
//end try11
end
//end begin11
else if adotable1.fieldbyname('isbmp').asstring ='0' then
begin
//begin12
jpegimage := tjpegimage.Create ;
try /
/try12
jpegimage.LoadFromStream(strm);
image1.Picture.Graphic := jpegimage;
finally
jpegimage.Free ;
end;
//end try12
end;
//end begin12
finally
strm.Free ;
end;
//end try1
end;
显示时必须分bmp and jpeg 两种情况处理,而保存可统一。
procedure TForm1.savetofileClick(Sender: TObject);
var
tmpstr:string;
begin
if image1.Picture.Graphic <> nil then
begin
tmpstr := openpicturedialog1.Filter;
if adotable1.fieldbyname('isbmp').asstring ='1' then
begin
openpicturedialog1.Filter := 'Bitmaps (*.bmp)|*.bmp';
if openpicturedialog1.Execute then
image1.Picture.SaveToFile(openpicturedialog1.FileName+'.bmp');
end
else
begin
openpicturedialog1.Filter := 'JPEG Image File (*.jpg)|*.jpg';
if openpicturedialog1.Execute then
image1.Picture.SaveToFile(openpicturedialog1.FileName+'.jpg');
end;
openpicturedialog1.Filter := tmpstr;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
form2.Show;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
adoconnection1.Connected := true;
adoconnection1.LoginPrompt := false;
adotable1.Active := true;
end;
procedure TForm1.ADOTable1BeforeScroll(DataSet: TDataSet);
begin
dbimage1.dataField :='';
//这条语句不能遗漏,不信你试试
end;
end.
转载请注明原文地址: https://ju.6miu.com/read-1303493.html
最新回复
(
0
)