⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 saveimage.pas

📁 《delphi数据库设计与实例开发》随书光盘
💻 PAS
字号:
unit SaveImage;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, StdCtrls, ExtCtrls, DBCtrls, ExtDlgs;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Image1: TImage;
    GroupBox2: TGroupBox;
    Panel1: TPanel;
    Image2: TImage;
    Button1: TButton;
    Button2: TButton;
    Table1: TTable;
    OpenPictureDialog1: TOpenPictureDialog;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if openpicturedialog1.Execute then
   image2.Picture.LoadFromFile(openpicturedialog1.FileName );
 Button2.Enabled:=True;
 Button1.Enabled:=False;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 stream:TMemoryStream;
begin
  with Table1 do
   begin
   Insert;
   FieldByName('Name').AsString:=ExtractFileName((OpenPictureDialog1.FileName));
   stream:=TMemoryStream.Create();
   stream.LoadFromFile(OpenPictureDialog1.FileName);
   TBlobField(FieldByName('ImageData')).LoadFromStream(stream);
   Post;
   end;
  with Table1 do
   begin
   ListBox1.Clear;
   First;
   while not Eof do
    begin
    ListBox1.Items.Add(FieldByName('Name').AsString);
    next;
   end;
  Button2.Enabled:=False;
 Button1.Enabled:=True;
end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
 stream:TStream;
 bmp:TBitmap;
begin
 with Table1 do
 begin
   Locate('Name',ListBox1.Items[ListBox1.ItemIndex],[loPartialKey]);
   bmp:=TBitmap.Create;
   stream:=CreateBlobStream(FieldByName('ImageData'),bmRead);
   stream.Position:=0;
   bmp.LoadFromStream(stream);
   Image1.Picture.Assign(bmp);
   bmp.Free;
   stream.Free;
 end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
try
 Table1.DatabaseName:='DBDEMOS';
 Table1.TableName:='Image.db';
 Table1.Active:=true;
 except
 On E:EdatabaseError do
 ShowMessage(E.Message);
 end;
  with Table1 do
   begin
   First;
   while not Eof do
    begin
    ListBox1.Items.Add(FieldByName('Name').AsString);
    next;
   end;
end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -