frm_zpdc.pas

用于家庭养殖的财务进出

unit frm_zpdc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, ExtCtrls,jpeg,DBTables,DB, ADODB, ComCtrls;
  {Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, ExtCtrls,jpeg,DBTables;}

type
  Tfrm_zp = class(TForm)
    DriveComboBox1: TDriveComboBox;
    Button1: TButton;
    Button3: TButton;
    DirectoryListBox1: TDirectoryListBox;
    Image1: TImage;
    Label1: TLabel;
    CheckBox1: TCheckBox;
    Label2: TLabel;
    PB1: TProgressBar;
    Label3: TLabel;
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject); //界面初始化，照片数量统计
    procedure DriveComboBox1Change(Sender: TObject);  //改变照片存放路径
    procedure Button1Click(Sender: TObject);   //照片导出
    procedure CheckBox1Click(Sender: TObject); //照片存放的默认路径
    procedure FormActivate(Sender: TObject);  //页面重新激活时，调用界面初始化
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frm_zp: Tfrm_zp;

implementation
  uses unit_global, data_module, Unit3;  //dmserver,globalvarunit;//
{$R *.dfm}

procedure Tfrm_zp.Button3Click(Sender: TObject);
begin
  close;
end;

procedure Tfrm_zp.FormCreate(Sender: TObject);
var
  filepath:string;
  peocount:integer;
begin
  label2.Caption:='';
  with dm.ADOQuery2 do
  begin
    close;
    sql.Clear;
    sql.Add('select * from photo');
    open;
    peocount:=recordcount;
  end;
  label2.Caption:='共有'+inttostr(peocount)+'人有照片';
  pb1.Position:=0;
  pb1.Step:=100 div peocount;
  //showmessage(inttostr(pb1.Step));
  checkbox1.Checked:=true;
  drivecombobox1.Drive:='d';
  filepath:=apppath+'zpdc';
  directorylistbox1.Drive:=drivecombobox1.Drive;
  directorylistbox1.Directory:=filepath;
end;

procedure Tfrm_zp.DriveComboBox1Change(Sender: TObject);
begin
   directorylistbox1.Drive:=drivecombobox1.Drive;
end;

procedure Tfrm_zp.Button1Click(Sender: TObject);
var
  tempjpeg:tjpegimage;
  TempStream:TMemoryStream;
    FS: TFileStream;
    MS: TMemoryStream ;
    SM: TStream;
  filename:string;
  path,filepath:string;
begin
  pb1.Position:=pb1.Min;  //2006-03 zjx
  if checkbox1.Checked then
    path:=apppath+'zpdc'
  else
    Path:=directorylistbox1.GetItemPath(directorylistbox1.ItemIndex);//+FileName+'.xls';
  if MessageDlg('确定是否存为'+path+' 路径下？',mtConfirmation, [mbYes, mbNo], 0) = mryes then
  begin
  try
    ReadCursor;     //2006-03 zjx
    with dm.AQ_PH do
    begin
      close;
      sql.Clear;
      sql.Add('select * from photo');
      open;
      first;
      while not eof do
      begin
        SM := dm.AQ_PH.CreateBlobStream(dm.AQ_PH.FieldByName('photo'),bmRead );
        if SM.Size > 0 then
        else
          exit;
        try
          tempstream := TMemoryStream.Create;
          tempjpeg:=tjpegimage.Create;
          TBlobField(dm.AQ_PH.FieldByName ('photo')).SaveToStream(tempstream);
          tempstream.Position:=0;
          tempjpeg.loadfromstream(tempstream);
          Image1.Picture.Assign(TempJpeg);
          filename:=dm.AQ_PH.FieldByName('prescode').asstring;
          if directorylistbox1.ItemIndex=0 then
            filepath:=path+filename+'.jpg'
          else
            filepath:=path+'\'+filename+'.jpg';
          image1.picture.savetofile(filepath);
          pb1.Position:=pb1.Position+pb1.Step;
        finally
          tempstream.free;
          tempjpeg.free;
        end;
        SM.Free;
        next;
      end;
    end;
  except
    raise Exception.Create('位图存放错误！');
    SM.Free;
  end;
  end;
  ResumeCursor;  //2006-03 zjx
end;

procedure Tfrm_zp.CheckBox1Click(Sender: TObject);
var
  filepath:string;
begin
  if checkbox1.Checked then
  begin
    drivecombobox1.Drive:='d';
    filepath:=apppath+'zpdc';
    directorylistbox1.Drive:=drivecombobox1.Drive;
    directorylistbox1.Directory:=filepath;
  end;
end;

procedure Tfrm_zp.FormActivate(Sender: TObject);
begin
  formcreate(sender);
end;

end.