DELPHI存取JPEG、BMP图像到数据库完整解决方案

    xiaoxiao2025-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)