中国程序员联盟 正在重新改版中ing 不便之处还请见谅 改版后将内容涉及java delphi .net php
 
  首页 | 数据库开发 | 网络通讯 | 多线程 | 多媒体开发 | 图像处理 | 程序人生 | 系统函数 | 控件开发 | Web服务
 
  当前位置:笨鱼delphi技术网>数据库开发>数据处理>文章内容

delphi 输入图片到Blob字段

来源:站内 关于:bill 发布时间:2007-06-21   [收藏] [推荐]

  procedure TForm1.Button1Click(Sender: TObject);
  var
    C: TClipboard;
  begin
    C := TClipboard.Create;
    try
      if Clipboard.HasFormat(CF_BITMAP) then

        DBImage1.PasteFromClipboard
      else
        ShowMessage('Clipboard does not contain a bitmap!');
    finally
      C.Free;
    end;
  end;


  procedure TForm1.Button2Click(Sender: TObject);
  begin
    Table1Bitmap.LoadFromFile(
      'c:\delphi\images\splash\16color\construc.bmp');
  end;

procedure TForm1.Button3Click(Sender: TObject);
  var
    B: TBitmap;
  begin
    B := TBitmap.Create;
    try
      B.LoadFromFile('c:\delphi\images\splash\16color\athena.bmp');
      DBImage1.Picture.Assign(B);
    finally
      B.Free;
    end;
  end;
///////////////////////////////////////////////////////////
var
  st: TStringStream;
begin
  st := tstringstream.create('');
  bitmap.savetostream(st);
  query1.sql.text := 'insert into table Image_field values :bmp';
  query1.parambyname('bmp').asblob := st.datastring;
  query1.execsql;
  st.free;
end;
////////////////////////////////////////////////////////////////////////
unit Unit1;

interface

{$IFDEF WIN32}
  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, Db,
      DBTables;
{$ELSE}
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DBTables, DB, Grids, DBGrids, ExtCtrls, StdCtrls;
{$ENDIF}

type
  TForm1 = class(TForm)
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Image1: TImage;
    Button1: TButton;
    Table1Name: TStringField;
    Table1WMF: TBlobField;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
  private
    { Private declarations }
    FileName : string; {Used to hold a temp file name}
    procedure LoadWMFFromDatabase; {loads a WMF from the database}
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 {Used for loading metafiles}
  OpenDialog1.Filter := 'Metafiles (*.wmf)|*.wmf';
  OpenDialog1.Options := [ofHideReadOnly, ofNoChangeDir];
  Image1.Stretch := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
 {Erase the temp file if it exists}
  if FileName <> '' then
    DeleteFile(FileName);
end;

{This function gets a temporary file name form the system}
function GetTemporaryFileName : string;
{$IFNDEF WIN32}
  const MAX_PATH = 144;
{$ENDIF}
var
 {$IFDEF WIN32}
  lpPathBuffer : PChar;
 {$ENDIF}
  lpbuffer : PChar;
begin
 {Get the file name buffer}
  GetMem(lpBuffer, MAX_PATH);
 {$IFDEF WIN32}
 {Get the temp path buffer}
  GetMem(lpPathBuffer, MAX_PATH);
 {Get the temp path}
  GetTempPath(MAX_PATH, lpPathBuffer);
 {Get the temp file name}
  GetTempFileName(lpPathBuffer,
                  'tmp',
                  0,
                  lpBuffer);
 {Free the temp path buffer}
  FreeMem(lpPathBuffer, MAX_PATH);
 {$ELSE}
 {Get the temp file name}
  GetTempFileName(GetTempDrive('C'),
                  'tmp',
                  0,
                  lpBuffer);
 {$ENDIF}
 {Create a pascal string containg}
 {the  temp file name and return it}
  result := StrPas(lpBuffer);
 {Free the file name buffer}
  FreeMem(lpBuffer, MAX_PATH);
end;

procedure TForm1.LoadWMFFromDatabase;
var
  FileStream: TFileStream; {a temp file}
  BlobStream: TBlobStream; {the WMF Blob}
begin
  Image1.Picture.Metafile.Assign(nil);
 {Create a blob stream for the WMF blob}
  BlobStream := TBlobStream.Create(Table1WMF, bmRead);
  if BlobStream.Size = 0 then begin
   BlobStream.Free;
   Exit;
  end;
 {if we have a temp file then erase it}
  if FileName <> '' then
    DeleteFile(FileName);
 {Get a temp file name}
  FileName := GetTemporaryFileName;
 {Create a temp file stream}
  FileStream := TFileStream.Create(FileName,
                                   fmCreate or fmOpenWrite);
 {Copy the blob to the temp file}
  FileStream.CopyFrom(BlobStream, BlobStream.Size);
 {Free the streams}
  FileStream.Free;
  BlobStream.Free;
 {Dispaly the image}
  Image1.Picture.Metafile.LoadFromFile(FileName);
end;

{Save a wmf file to the database}
procedure TForm1.Button1Click(Sender: TObject);
var
  FileStream: TFileStream; {to load the wmf file}
  BlobStream: TBlobStream; {to save to the blob}
begin
 {Allow the button to repaint}
  Application.ProcessMessages;
  if OpenDialog1.Execute then begin
   {Turn off the button}
    Button1.Enabled := false;
   {Assign the avi file name to read}
    FileStream := TFileStream.Create(OpenDialog1.FileName,
                                     fmOpenRead);
    Table1.Edit;
   {Create a BlobStream for the field Table1WMF}
    BlobStream := TBlobStream.Create(Table1WMF, bmReadWrite);
   {Seek to the Begginning of the stream}
    BlobStream.Seek(0, soFromBeginning);
   {Delete any data that may be there}
    BlobStream.Truncate;
   {Copy from the FileStream to the BlobStream}
    BlobStream.CopyFrom(FileStream, FileStream.Size);
   {Free the streams}
    FileStream.Free;
    BlobStream.Free;
   {Post the record}
    Table1.Post;
   {Load the metafile in to a TImage}
    LoadWMFFromDatabase;
   {Enable the button}
    Button1.Enabled := true;
  end;
end;

procedure TForm1.DataSource1DataChange(Sender: TObject; Field: TField);
begin
  if (Sender as TDataSource).State = dsBrowse then
    LoadWMFFromDatabase;
end;

end.


[浏览: 次]   
上一篇:delphi 从Blob字段中提取图片   下一篇:delphi 运行创建、删除字段
[收藏] [推荐] [返回顶部] [打印本页] [关闭窗口]  
    评论加载中…
google adsense热点文章
·delphi Delphi 中使用原生 ADO 控制数
·delphi Base64编码/解码及ZLib压缩/解
·delphi Delphi_有关ADO专题
·delphi Delphi下的ADO
·delphi 数据库事务处理
·delphi DataSet数据复制
·delphi Oracle9i 如何用sysdba连接数据
·delphi 多线程执行数据库查询
·delphi 开发数据库程序经验三则
·delphi 将纯文本导入数据库
·delphi 如何给日期时间字段赋空值
·delphi 使用TQuery 的误区
     delphi技术网 | firefox 下载 | Avant Browser下载 | dedecms 技术网 | drupal 爱好者 | php 技术网
  Copyright@www.delphichm.com,2006-2009.All Rights Reserved.
 
程序员联盟 | delphi Java .net|QQ:707102932