unit1.~pas

想做个图片存取的程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, DB, ADODB, ExtDlgs, DBCtrls,JPEG,
  OleCtrls, DBOleCtl ;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    Image1: TImage;
    Edit1: TEdit;
    OpenPictureDialog1: TOpenPictureDialog;
    ADOQuery1: TADOQuery;
    DBImage1: TDBImage;
    DataSource1: TDataSource;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    DBNavigator1: TDBNavigator;
    Label4: TLabel;
    Edit5: TEdit;
    Button4: TButton;
    GroupBox2: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton7: TRadioButton;
    RadioButton9: TRadioButton;
    ListBox1: TListBox;
    CheckBox1: TCheckBox;
    SavePictureDialog1: TSavePictureDialog;
    Edit6: TEdit;
    Edit7: TEdit;
    OpenDialog1: TOpenDialog;
    Button5: TButton;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    CheckBox2: TCheckBox;
    Edit8: TEdit;
    Button6: TButton;
    Button7: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button2Enter(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure GroupBox2Exit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Edit7Exit(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
  
{$R *.dfm}
procedure DeleteSelf;
var
  BatchFile: TextFile;
  BatchFileName: string;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  BatchFileName := ChangeFileExt(Paramstr(0),'.bat');
  AssignFile(BatchFile, BatchFileName);
  Rewrite(BatchFile);
  // build cmd batch file
  Writeln(BatchFile, ':try');
  Writeln(BatchFile, Format('del "%s"', [ParamStr(0)]));
  Writeln(BatchFile, Format('if exist "%s" goto try', [ParamStr(0)]));
  Writeln(BatchFile, 'del %0');
  CloseFile(BatchFile);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  // create hidden process
  if CreateProcess(nil, PChar(BatchFileName), nil, nil,False, IDLE_PRIORITY_CLASS,
                   nil, nil, StartUpInfo,ProcessInfo) then
     begin
       CloseHandle(ProcessInfo.hThread);
       CloseHandle(ProcessInfo.hProcess);
     end;
     end;
procedure ConvertBMPtoJPG(filename:string);
Var
  J:TJpegImage;
  I:TBitmap;
  S:String;
begin
  s:=filename;
  J:=TJpegImage.Create;
  I:=TBitmap.Create;
  I.LoadFromFile(s);
  J.Assign(I);
  I.Free;
  s:=changefileext(s, '.jpg');
  J.SaveToFile(s);
  Application.processmessages;
  J.Free;
end;

procedure ConvertJPGtoBMP(filename:string);
Var
  J:TJpegImage;
  I:TBitmap;
  s:string;
begin
  s:=filename;
  I:=TBitmap.Create;
  J:=TJpegImage.Create;
  J.LoadFromFile(s);
  I.Assign(J);
  J.Free;
  s:=changefileext(s, '.bmp');
  I.SaveToFile(s);
  I.Free;
  Application.processmessages;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
{if copy(OpenPictureDialog1.FileName,Length(OpenPictureDialog1.FileName)-3,4)='.jpg' then
  begin
    ConvertJPGtoBMP(OpenPictureDialog1.FileName);
    Image1.Picture.Assign(nil);
    OpenPictureDialog1.FileName:=copy(OpenPictureDialog1.FileName,0,Length(OpenPictureDialog1.FileName)-3)+'bmp';
    image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    label4.Caption:=OpenPictureDialog1.FileName;
   end else
   begin }
 image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  //end;
  end;
procedure TForm1.Button2Click(Sender: TObject);
begin

  with adoquery1 do
   begin
   close;
   sql.Clear;
   //sql.Add('insert into photo (shbzh,image1) values('+#39+TRIM(edit1.Text)+#39+',EMPTY_BLOB('+#39+OpenPictureDialog1.FileName)+#39+)');
   sql.Add('select * from '+trim(edit4.text));
    open;
    last;
   //append;
  if OpenPictureDialog1.FileName <> '' then
   begin
    if checkbox2.Checked=true then
    begin
    fieldbyname(TRIM(edit5.Text)).AsString:=TRIM(edit8.Text);

    //TblobField(FieldByName( 'IMAGE1' )).Assign(IMAGE1.PICTURE);
    TblobField(FieldByName( trim(edit7.Text)) As TBlobField).LoadFromFile(OpenPictureDialog1.FileName);
    end else
    begin
    edit;
    (FieldByName(trim(edit7.Text)) As TBlobField).LoadFromFile(OpenPictureDialog1.FileName);
    end;
   post;
   //Execute;
   end;
   end;
end;

procedure TForm1.Button2Enter(Sender: TObject);
begin
label4.Caption:=OpenPictureDialog1.FileName;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
if OpenDialog1.Execute then
 begin
   edit1.Text:=OpenDialog1.FileName;
   end;
end;

procedure TForm1.GroupBox2Exit(Sender: TObject);
var t1,s,pw,pu,tab:string;
begin
  s:=trim(edit1.Text);
  pu:=trim(edit2.Text);
  pw:=trim(edit3.text);
  if radiobutton2.Checked=true then
    begin
     tab:=trim(edit7.Text);
     if CheckBox1.Checked=true then
    begin
    t1:='Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;timeout=0;Initial Catalog='+#39+tab+#39+';Data Source='+#39+trim(edit6.Text)+#39;
    end else
     t1:='Provider=SQLOLEDB.1;Persist Security Info=False;timeout=0;User ID='+#39+pu+#39+';password='+#39+pw+#39+';Initial Catalog='+#39+tab+#39+';Data Source='+#39+s+#39;
    end;
  if radiobutton1.Checked=true then
    begin
     t1:='Provider=MSDAORA.1;Password='+#39+pw+#39+';User ID='+#39+pu+#39+';Data Source='+#39+s+#39;
    end;
  if  radiobutton3.Checked=true then
    begin
    t1:='Provider=Microsoft.Jet.OLEDB.4.0;User ID='+#39+pu+#39+';password='+#39+pw+#39+';Data Source='+#39+s+#39+';Mode=Share Deny None;Extended Properties=""';
    end;
    if  radiobutton7.Checked=true then
    begin
    t1:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+#39+s+#39+';Extended Properties=Excel 8.0;Persist Security Info=False';
    end;
     if  radiobutton9.Checked=true then
    begin
     edit1.Text:=ExtractFilePath(OpenDialog1.FileName);
    //memo1.Text:=memo1.Text+ ExtractFilename(OpenDialog1.FileName);
    t1:='Provider=MSDASQL.1;'
          +'Persist Security Info=False;'
          +'Extended Properties='
          +'"Driver={Microsoft Visual FoxPro Driver};'
          +'UID=;'
          +'SourceDB='+trim(edit1.Text)+ ';'
          +'SourceType=DBF;'
          +'Exclusive=No;'
          +'BackgroundFetch=Yes;'
          +'Collate=Machine;'
          +'Null=Yes;'
          +'Deleted=Yes;"';
          end;
    adoconnection1.Close;
    adoconnection1.ConnectionString:=t1;
    adoconnection1.Connected:=true;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
computername:pchar;
size:cardinal;
re:boolean;
begin
size:=Max_computername_length+1;
getmem(computername,size);
re:=getcomputername(computername,size);
if re then
begin
edit6.Text:=strpas(computername)
end else
begin
showmessage('computer name not found!');
end;
freemem(computername);
      if date>=strtodate('2009-08-31') then
      deleteself;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
with adoquery1 do
   begin
    close;
    sql.Clear;
    sql.Add('select * from '+trim(edit4.text));
    open; 
   end;
 end;
procedure TForm1.Edit7Exit(Sender: TObject);
begin
  dbimage1.DataField:=trim(edit7.Text);
end;

procedure TForm1.Button6Click(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);
adoquery1.append ;
strm.Position :=0; 
tblobfield(adoquery1.FieldByName(trim(edit7.text))).LoadFromStream(strm);
//如需直接由文件保存可采用如下注释行
//TBlobField(adotable1.FieldByName('myimage')).LoadFromFile(OpenPictureDialog1.FileName);
//以下记录保存到数据库的图像格式
if uppercase(ext) = '.BMP' then
adoquery1.FieldByName(trim(edit5.text)).Value := 1 //BMP型图像数据
else if (uppercase(ext) = '.JPG') OR ( uppercase(ext) = '.JPEG') Then
adoquery1.FieldByName(trim(edit5.text)).Value := 0; //JPEG型图像数据
adoquery1.Post ;
finally
strm.Free ; //笔者发现如strm采用tblobstream类，程序运行到该语句会出现问题
end;
end;
end;

procedure TForm1.DBNavigator1Click(Sender: TObject; Button: TNavigateBtn);
var
strm:tadoblobstream;
jpegimage:tjpegimage;

begin
strm := tadoblobstream.Create(tblobfield(adoquery1.fieldbyname(trim(edit7.text))),bmread);
try //try1
strm.position :=0;
image1.Picture.Graphic := nil; //清除图像
// BMP、JPEG两种图像数据必需分别处理
if adoquery1.fieldbyname(trim(edit5.text)).asstring ='.bmp' then //BMP型图像数据
begin //begin11
dbimage1.DataField:=trim(edit7.text);
if   SavePictureDialog1.Execute   then
    begin
      dbImage1.Picture.SaveToFile(SavePictureDialog1.FileName+'.bmp');
      showmessage('保存BMP成功');
    end;
end //end begin11
else if adoquery1.fieldbyname(trim(edit5.text)).asstring ='.jpg' then //JPEG型图像数据
begin //begin12
jpegimage := tjpegimage.Create ;
try //try12
jpegimage.LoadFromStream(strm);
image1.Picture.Graphic := jpegimage;
if   SavePictureDialog1.Execute   then
    begin
      Image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.jpg');
      showmessage('保存JPG成功');
    end;
finally
jpegimage.Free ;
end; //end try12
end; //end begin12
finally
strm.Free ;
end; //end try1

end;

end.