unit U_TPUp; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ComCtrls, ToolWin, ExtCtrls, cxGridLevel, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGrid, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, StdCtrls, ADODB, jpeg, BtnEdit, IniFiles, strutils, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxSkinsCore, dxSkinsDefaultPainters, dxDateRanges, IdExplicitTLSClientServerBase, Vcl.ExtDlgs, dxSkinWXI, dxScrollbarAnnotations,URLMon,ShellApI; type TfrmTPUp = class(TForm) cxGrid7: TcxGrid; TV7: TcxGridDBTableView; FileName: TcxGridDBColumn; FileDate: TcxGridDBColumn; cxGridLevel6: TcxGridLevel; Panel16: TPanel; ToolBar6: TToolBar; FileUp: TToolButton; FileDel: TToolButton; Panel1: TPanel; Label1: TLabel; Code: TEdit; ODPat: TOpenDialog; IdFTP1: TIdFTP; SaveDialog1: TSaveDialog; ADOQueryFile: TADOQuery; DataSource1: TDataSource; ADOQueryCmd: TADOQuery; ADOQueryTemp: TADOQuery; Image2: TImage; Image1: TImage; TV7Column1: TcxGridDBColumn; Label2: TLabel; HXName: TBtnEditC; ADOQuery1: TADOQuery; procedure FileUpClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FileDelClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure HXNameBtnUpClick(Sender: TObject); procedure HXNameBtnDnClick(Sender: TObject); procedure TV7CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean); private lstPat: TStringList; AJpeg: TJPEGImage; procedure CreThumb(Image1, Image2: TImage; Width, Height: Integer); procedure SaveImageOther(FTFID: string); procedure ReadINIFile10(); procedure InitTP(); { Private declarations } public FBCIID: string; FWidth, FHeight:Integer { Public declarations } end; var frmTPUp: TfrmTPUp; implementation uses U_DataLink, U_RTFun, U_ZDYHelp; {$R *.dfm} procedure TfrmTPUp.InitTP(); begin with ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select TFID,WBID,TFDate,Files,Filler,FillTime,FileName,HXName from TP_File where WBID=''' + Trim(FBCIID) + ''''); SQL.Add(' and FileType=''KH'''); Open; end; end; procedure TfrmTPUp.ReadINIFile10(); var programIni: Tinifile; //配置文件名 FileName: string; begin FileName := ExtractFilePath(Paramstr(0)) + 'SYSTEMSET.INI'; programIni := Tinifile.create(FileName); server := programIni.ReadString('SERVER', '服务器地址', '127.0.0.1'); programIni.Free; end; procedure TfrmTPUp.FileUpClick(Sender: TObject); var i, j, ii: Integer; PatFile: string; FTPPath, FConNo, MaxNo: string; AJpeg: TJPEGImage; myStream: TADOBlobStream; f: file of Byte; size: Longint; S: Double; begin if Trim(Code.Text) = '' then begin Application.MessageBox('编号不能为空!', '提示', 0); Exit; end; // if Trim(HXName.Text) = '' then // begin // if Application.MessageBox('花型确认为空吗?', '提示', 32 + 4) <> IDYES then // Exit; // end; lstPat.Clear; if ODPat.Execute then begin lstPat.AddStrings(ODPat.Files); end; if lstPat.Count > 0 then begin try IdFTP1.Host := PicSvr; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); except IdFTP1.Quit; Application.MessageBox('无法连接到文件服务器,请检查!', '提示', MB_ICONWARNING); Exit; end; end; Panel16.Visible := True; Panel16.Refresh; try AJpeg := TJpegImage.Create(); ADOQueryCmd.Connection.BeginTrans; ii := 0; for i := 0 to lstPat.Count - 1 do begin with ADOQueryTemp do begin Close; sql.Clear; sql.Add('select isnull(max(abs(cast(right(left(FileName,charindex(''.'',FileName)-1),2) as int))),0)+1 as BH from TP_File'); sql.Add('where FileType =''KH'' and WBID=''' + trim(FBCIID) + ''' '); open; end; PatFile := trim(FBCIID) + '-' + inttostr(ADOQueryTemp.fieldbyname('BH').AsInteger) + '.' + Copy(ExtractFileName(lstPat[i]), (Pos('.', ExtractFileName(lstPat[i])) + 1), (Length(ExtractFileName(lstPat[i])) - Pos('.', ExtractFileName(lstPat[i])))); image1.Picture.LoadFromFile((lstPat[i])); CreThumb(Image1, Image2, FWidth, FHeight); if IdFTP1.Connected then begin try IdFTP1.Put(lstPat[i], Trim(UserDataFlag + 'YP' + '\' + Trim(PatFile))); if GetLSNo(ADOQueryCmd, MaxNo, 'YP', 'XD_File', 4, 1) = False then raise Exception.Create('取图片最大号失败!'); with ADOQueryCmd do begin close; sql.Clear; sql.Add(' select * from TP_File where TFID=''' + Trim(MaxNo) + ''''); open; end; with ADOQueryCmd do begin if ADOQueryCmd.IsEmpty then begin Append; FieldByName('Filler').Value := Trim(DName); FieldByName('TFDate').Value := SGetServerDateTime(ADOQueryTemp); end else begin Edit; FieldByName('Editer').Value := Trim(DName); FieldByName('EditTime').Value := SGetServerDateTime(ADOQueryTemp); end; FieldByName('TFID').Value := Trim(MaxNo); FieldByName('WBID').Value := Trim(FBCIID); FieldByName('TFType').Value := '客户'; FieldByName('FileType').Value := 'KH'; FieldByName('HXName').Value := trim(HXName.Text); FieldByName('filename').Value := Trim(PatFile); myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite); AJpeg.Assign(Image2.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; Post; end; except raise Exception.Create('上传图片失败!'); end; end; end; ADOQueryCmd.Connection.CommitTrans; AJpeg.Free; except AJpeg.Free; ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('图片上传失败!', '提示', 0); end; if IdFTP1.Connected then IdFTP1.Quit; InitTP(); Panel16.Visible := False; if ii > 0 then Application.MessageBox(PChar(inttostr(ii) + '个文件大于2MB,上传失败!'), '提示', 0); if i > 0 then Application.MessageBox(PChar(inttostr(i-ii) + '个文件上传成功!'), '提示', 0); ModalResult := 1; end; procedure TfrmTPUp.CreThumb(Image1, Image2: TImage; 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); Image2.Picture.Assign(Bitmap); finally Bitmap.Free; end; end; procedure TfrmTPUp.SaveImageOther(FTFID: string); var AJpeg: TJPEGImage; myStream: TADOBlobStream; ImgMaxNo: string; i, j: Integer; PatFile: string; FConNo, MaxNo: string; begin if Image2.Picture = nil then Exit; AJpeg := TJpegImage.Create(); with ADOQueryCmd do begin close; sql.Clear; sql.Add(' select * from TP_File where TFID=''' + Trim(FTFID) + ''''); open; end; with ADOQueryCmd do begin if Trim(FTFID) = '' then begin Append; FieldByName('Filler').Value := Trim(DName); end else begin Edit; FieldByName('Editer').Value := Trim(DName); FieldByName('EditTime').Value := SGetServerDateTime(ADOQueryTemp); end; FieldByName('TFID').Value := Trim(FTFID); FieldByName('WBID').Value := Trim(FBCIID); FieldByName('TFType').Value := '样品'; AJpeg.Assign(Image2.Picture.Graphic); myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite); AJpeg.Assign(Image2.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; Post; end; end; procedure TfrmTPUp.TV7CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean); var IdFTP1: TIdFTP; FPath, FFName, fPdfFilePath, fPdfFilePath1: string; FInt: integer; begin if not DirectoryExists(pchar('D:\Right1209')) then CreateDirectory(pchar('D:\Right1209'), nil); fPdfFilePath := 'D:\Right1209\' + ADOQueryFile.FieldByName('FileName').ASString; if not DirectoryExists(pchar(fPdfFilePath)) then CreateDirectory(pchar(fPdfFilePath), nil); // with ADOQuery1 do // begin // close; // sql.Clear; // sql.Add('select * from TP_File A'); // sql.Add('where isnull(WBID,'''')<>'''' and WBID=' + quotedstr(Trim(ADOQueryFile.FieldByName('WB')))); // open; // end; // ADOQueryFile.First; // while not ADOQueryFile.Eof do // begin // if Trim(ADOQueryFile.FieldByName('URL').AsString) <> '' then // begin fPdfFilePath1 := fPdfFilePath + '\' + trim(Trim(ADOQueryFile.FieldByName('FileName').AsString)); UrlDownloadToFile(nil, PChar(Trim(ADOQueryFile.FieldByName('url').AsString)), PChar(fPdfFilePath1), 0, nil); ShellExecute(Handle, 'open', PChar(fPdfFilePath + '\' + trim(ADOQueryFile.FieldByName('FileName').AsString)), '', '', SW_SHOWNORMAL); // end; // ADOQueryFile.Next; // end; // ShellExecute(Handle, 'open', PChar(fPdfFilePath + '\' + trim(FileName)), '', '', SW_SHOWNORMAL); end; procedure TfrmTPUp.FormCreate(Sender: TObject); begin lstPat := TStringList.Create; if FWidth = 0 then FWidth := 160; if FHeight = 0 then FHeight := 120; end; procedure TfrmTPUp.FileDelClick(Sender: TObject); begin with ADOQueryCmd do begin Close; sql.Clear; SQL.Add(' Delete TP_File where TFID=''' + Trim(ADOQueryFile.fieldbyname('TFID').AsString) + ''''); ExecSQL; end; with ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select TFID,WBID,TFDate,Files,Filler,FillTime,FileName from TP_File where WBID=''' + Trim(FBCIID) + ''''); SQL.Add(' and FileType=''KH'''); Open; end; // if ADOQueryFile.IsEmpty then // begin // with ADOQueryCmd do // begin // Close; // sql.Clear; // sql.Add('Update CP_YDang Set TPFlag=0 where FBCIID=''' + Trim(FBCIID) + ''''); // ExecSQL; // end; // end; end; procedure TfrmTPUp.FormShow(Sender: TObject); begin with ADOQueryFile do begin Close; SQL.Clear; SQL.Add('select TFID,WBID,TFDate,Files,Filler,FillTime,FileName,url from TP_File where WBID=''' + Trim(FBCIID) + ''''); // SQL.Add(' and FileType=''KH'''); Open; end; end; procedure TfrmTPUp.HXNameBtnDnClick(Sender: TObject); begin TBtnEditC(Sender).Text := ''; TBtnEditC(Sender).TxtCode := ''; end; procedure TfrmTPUp.HXNameBtnUpClick(Sender: TObject); begin try frmZDYHelp := TfrmZDYHelp.Create(Application); with frmZDYHelp do begin flag := 'HX' + Trim(Code.Text); flagname := '花型'; if ShowModal = 1 then begin TEdit(Sender).Text := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString); end; end; finally frmZDYHelp.Free; end; end; end.