unit U_FjList_RZ1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ComCtrls, Menus, cxLookAndFeelPainters, StdCtrls, cxButtons, DB, ADODB, ImgList,shellapi, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls, cxGridCustomView, cxGrid, ExtDlgs,jpeg,IniFiles, cxContainer, cxImage, cxDBEdit,StrUtils; type TfrmFjList_RZ1 = class(TForm) ListView1: TListView; Panel1: TPanel; FileName: TcxButton; cxButton1: TcxButton; cxButton2: TcxButton; cxButton3: TcxButton; ADOQueryTmp: TADOQuery; ADOQueryCmd: TADOQuery; ImageList1: TImageList; Panel2: TPanel; IdFTP1: TIdFTP; ADOConnection1: TADOConnection; Tv1: TcxGridDBTableView; cxGrid1Level1: TcxGridLevel; cxGrid1: TcxGrid; v1Column1: TcxGridDBColumn; v1Column2: TcxGridDBColumn; v1Column3: TcxGridDBColumn; DataSource1: TDataSource; OpenPictureDialog1: TOpenPictureDialog; SaveDialog1: TSavePictureDialog; Image2: TImage; Picture4: TcxDBImage; ADOQuery1: TADOQuery; procedure cxButton3Click(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FileNameClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure ListView1DblClick(Sender: TObject); procedure cxButton1Click(Sender: TObject); procedure cxButton2Click(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Panel2DblClick(Sender: TObject); procedure Tv1DblClick(Sender: TObject); procedure CreThumb(Width, Height: Integer); procedure Tv1CellClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean); private procedure InitData(); { Private declarations } public fkeyNO:string; fType:string; fId:integer; fstatus:integer; QFilePath:string; QFileName:string; MyJpeg: TJPEGImage; fFlileFlag:string; // fmanage:string; { Public declarations } end; var frmFjList_RZ1: TfrmFjList_RZ1; implementation uses U_DataLink,U_Fun10,U_CompressionFun; {$R *.dfm} procedure TfrmFjList_RZ1.InitData(); var ListItem: TListItem; Flag: Cardinal; info: SHFILEINFOA; Icon: TIcon; begin ListView1.Items.Clear; try with adoqueryTmp do begin close; sql.Clear; sql.Add('select * from TP_File '); sql.Add('where WBID='+quotedstr(trim(fkeyNO))); sql.Add('and TFType='+quotedstr(trim(fType))); open; { if not IsEmpty then begin while not eof do begin with ListView1 do begin LargeImages := ImageList1; Icon := TIcon.Create; ListItem := Items.Add; Listitem.Caption := trim(fieldbyname('fileName').AsString); // Listitem.SubItems.Add(OpenDiaLog.FileName); Flag := (SHGFI_SMALLICON or SHGFI_ICON or SHGFI_USEFILEATTRIBUTES); SHGetFileInfo(Pchar(trim(fieldbyname('fileName').AsString)), 0, info, Sizeof(info), Flag); Icon.Handle := info.hIcon; ImageList1.AddIcon(Icon); ListItem.ImageIndex := ImageList1.Count - 1; end; next; end; end; } end; except end; end; procedure TfrmFjList_RZ1.cxButton3Click(Sender: TObject); begin ADOQueryTmp.Close; ADOQuerycmd.Close; ListView1.Items.Free; ModalResult:=-1; end; procedure TfrmFjList_RZ1.FormDestroy(Sender: TObject); begin MyJpeg.Free; frmFjList_RZ1:=nil; end; procedure TfrmFjList_RZ1.CreThumb(Width, Height: Integer); var Bitmap: TBitmap; Ratio: Double; ARect: TRect; AHeight, AHeightOffset: Integer; AWidth, AWidthOffset: Integer; begin Bitmap := TBitmap.Create; try {Ratio := Image1.Picture.Graphic.Width/Image1.Picture.Graphic.Height; if Ratio > 1.333 then begin AHeight := Round(Width/Ratio); AHeightOffset := (Height-AHeight) div 2; AWidth := Width; AWidthOffset := 0; end else begin AWidth := Round(Height*Ratio); AWidthOffset := (Width-AWidth) div 2; AHeight := Height; AHeightOffset := 0; end;} Bitmap.Width := Width; Bitmap.Height := Height; Bitmap.Canvas.Brush.Color := clBtnFace; Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height)); ARect := Rect(AWidthOffset, AHeightOffset, AWidth+AWidthOffset, AHeight+AHeightOffset); //Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic); // Assign back to the Jpeg, and save to the file Image2.Picture.Assign(BitMap); finally Bitmap.Free; end; end; procedure TfrmFjList_RZ1.FileNameClick(Sender: TObject); var OpenDiaLog: TOpenDialog; fFileName:string; fFilePath:string; maxNo:string; // myStream: TADOBlobStream; FJStream : TMemoryStream; mfileSize:integer; mCreationTime:TdateTime; mWriteTime:TdateTime; myStream: TADOBlobStream; begin try {OpenDiaLog := TOpenDialog.Create(Self); if OpenDiaLog.Execute then begin fFilePath:=OpenDiaLog.FileName; fFileName:=ExtractFileName(OpenDiaLog.FileName); Panel2.Caption:='正在上传数据,请稍等...'; Panel2.Visible:=true; application.ProcessMessages; if GetLSNo(ADOQueryCmd,maxNo,'FJ','TP_File',4,1)=False then begin Application.MessageBox('取最大号失败!','提示',0); Exit; end; //获取文件信息 GetFileInfo(fFilePath,mfileSize,mCreationTime,mWriteTime);} if OpenPictureDialog1.Execute then begin {Image1.Top := 0; Image1.Left := 0; Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);} QFilePath:=OpenPictureDialog1.FileName; QFileName:=ExtractFileName(QFilePath); CreThumb(240, 180); //Image1.Visible:=false; end; adoqueryCmd.Connection.BeginTrans; with adoqueryCmd do begin close; sql.Clear; sql.Add('delete from TP_File '); sql.Add('where TFID='+quotedstr(trim(maxNO))); execsql; end; try FJStream:=TMemoryStream.Create; with adoqueryCmd do begin close; sql.Clear; sql.Add('select * from TP_File '); sql.Add('where TFID='+quotedstr(trim(maxNO))); open; append; fieldbyname('TFID').Value:=trim(maxNO); fieldbyname('WBID').Value:=trim(fkeyNO); fieldbyname('TFType').Value:=trim(fType); fieldbyname('Filler').Value:=trim(DName); FieldByName('filltime').Value:=Now; fieldbyname('FileName').Value:=trim(formatdatetime('yyyyMMddhhnnsszzz',now())+ExtractFileExt(QFilePath)); //fieldbyname('TFDate').Value:=mWriteTime; myStream := TADOBlobStream.Create(TBlobField(FieldByName('Filesother')), bmWrite); MyJpeg.Assign(Image2.Picture.Graphic); MyJpeg.SaveToStream(myStream); myStream.Free; post; end; {if fFilePath <> '' then begin try IdFTP1.Host := PicSvr; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); IdFTP1.Put(fFilePath, 'FJ\' + Trim(fFileName)); IdFTP1.Quit; except IdFTP1.Quit; Application.MessageBox('上传客户图样文件失败,请检查文件服务器!', '提示', MB_ICONWARNING); end; end; IdFTP1.Quit;} Panel2.Visible:=false; initdata(); finally FJStream.Free; end; adoqueryCmd.Connection.CommitTrans; except adoqueryCmd.Connection.RollbackTrans; application.MessageBox('附件保存失败!','提示信息',0); end; end; procedure TfrmFjList_RZ1.FormCreate(Sender: TObject); begin with ADOConnection1 do begin Connected:=false; ConnectionString:=DConString; //ConnectionString:=''; Connected:=true; end; MyJpeg := TJpegImage.Create; cxGrid1.Align:=alclient; fstatus:=0; end; procedure TfrmFjList_RZ1.FormShow(Sender: TObject); begin IF fstatus=0 then Panel1.Visible:=true else Panel1.Visible:=false; initdata(); end; procedure TfrmFjList_RZ1.ListView1DblClick(Sender: TObject); var sFieldName:string; fileName:string; begin if ListView1.Items.Count<1 THEN EXIT; if listView1.SelCount<1 then exit; sFieldName:='D:\图片查看'; if not DirectoryExists(pchar(sFieldName)) then CreateDirectory(pchar(sFieldName),nil); fileName:=ListView1.Selected.Caption; sFieldName:=sFieldName+'\'+trim(fileName); try IdFTP1.Host := PicSvr; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); except ; end; if IdFTP1.Connected then begin Panel2.Caption:='正在下载数据,请稍等...'; Panel2.Visible:=true; application.ProcessMessages; try IdFTP1.Get('FJ\'+ Trim(fileName), sFieldName,false, true); except Panel2.Visible:=false; Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING); IdFTP1.Quit; Exit; end; end else begin Panel2.Visible:=false; Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING); IdFTP1.Quit; Exit; end; Panel2.Visible:=false; if IdFTP1.Connected then IdFTP1.Quit; ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL); end; procedure TfrmFjList_RZ1.cxButton1Click(Sender: TObject); var fFileName:string; fFilePath:string; begin // if listView1.SelCount<1 then exit; IF ADOQueryTmp.IsEmpty then exit; try // fFileName:=ListView1.Selected.Caption; // ADOQueryTmp.Locate('fileName',fFileName,[]); with ADOQueryCmd do begin close; sql.Clear; sql.Add('delete from TP_File '); sql.Add('where TFID='+quotedstr(trim(ADOQueryTmp.fieldbyname('TFID').AsString))); // sql.Add('and TFType='+quotedstr(trim(fType))); // sql.Add('and FileName='+quotedstr(trim(fFileName))); execsql; end; initData(); except end; end; procedure TfrmFjList_RZ1.cxButton2Click(Sender: TObject); var SaveDialog: TSaveDialog; fFileName:string; fFilePath:string; ff: TADOBlobStream; FJStream : TMemoryStream; begin if adoqueryTmp.IsEmpty then exit; try fFileName:=adoqueryTmp.fieldbyname('FileName').AsString; SaveDialog := TSaveDialog.Create(Self); SaveDialog.FileName:=fFileName; if SaveDialog.Execute then begin Panel2.Caption:='正在保存数据,请稍等...'; Panel2.Visible:=true; application.ProcessMessages; fFilePath:=SaveDialog.FileName; try ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead); fjStream:= TMemoryStream.Create ; ff.SaveToStream(fjStream); UnCompressionStream(fjStream); fjStream.SaveToFile(fFilePath); // ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL); finally fjStream.free; ff.Free; end; Panel2.Visible:=false; // if IdFTP1.Connected then IdFTP1.Quit; end; except Panel2.Visible:=false; end; end; procedure TfrmFjList_RZ1.FormClose(Sender: TObject; var Action: TCloseAction); begin if fId=10 then Action:=cafree else Action:=cahide; end; procedure TfrmFjList_RZ1.Panel2DblClick(Sender: TObject); begin Panel2.Visible:=false; end; procedure TfrmFjList_RZ1.Tv1DblClick(Sender: TObject); var sFieldName:string; fileName:string; ff: TADOBlobStream; FJStream : TMemoryStream; jpg:TJpegImage; myStream: TADOBlobStream; begin IF adoqueryTmp.IsEmpty then exit; sFieldName:='D:\图片查看'; if not DirectoryExists(pchar(sFieldName)) then CreateDirectory(pchar(sFieldName),nil); fileName:=adoqueryTmp.fieldbyname('FileName').AsString; sFieldName:=sFieldName+'\'+trim(fileName); try ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead); jpg:=TJpegImage.Create(); jpg.LoadFromStream(ff); jpg.SaveToFile(sFieldName); {myStream := TADOBlobStream.Create(TBlobField(adoqueryTmp.FieldByName('Filesother')), bmWrite); MyJpeg.Assign(ADOQueryTmp.FieldByName('Filesother')); MyJpeg.SaveToStream(myStream); MyJpeg.SaveToFile(sFieldName); myStream.Free;} ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL); finally fjStream.free; ff.Free; end; {IF Picture4.Picture.Height=0 then exit; sFieldName:=leftbstr(ExtractFilePath(Application.ExeName),1)+':\图片查看'; if not DirectoryExists(pchar(sFieldName)) then CreateDirectory(pchar(sFieldName),nil); fileName:=adoqueryTmp.fieldbyname('FileName').AsString; sFieldName:=sFieldName+'\'+trim(fileName); //ShowMessage(sFieldName); try IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','服务器地址','127.0.0.1'); IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); except ; end; if IdFTP1.Connected then begin application.ProcessMessages; try IdFTP1.Get(fFlileFlag+'\'+ Trim(fileName), sFieldName,true, false); except Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING); IdFTP1.Quit; Exit; end; end else begin Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING); IdFTP1.Quit; Exit; end; if IdFTP1.Connected then IdFTP1.Quit; ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);} end; procedure TfrmFjList_RZ1.Tv1CellClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean); var PicStream: TMemoryStream; begin if not ADOQueryTmp.FieldByName('filesother').IsNull then begin try PicStream := TMemoryStream.Create; TBlobField(ADOQueryTmp.FieldByName('filesother')).SaveToStream(PicStream); PicStream.Position := 0; Picture4.Picture.Bitmap.LoadFromStream(PicStream); PicStream.Free; except ShowMessage('对不起,图片有问题.'); end; end; end; end.