unit U_SLT_TJ_CS; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,jpeg, cxControls, cxContainer, cxEdit, cxImage,IdFTP,ShellAPI, StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, Menus,DBClient,IniFiles, cxTextEdit, cxCurrencyEdit; type TfrmSLT_TJ_CS = class(TFrame) PopupMenu1: TPopupMenu; N1: TMenuItem; ODPat: TOpenDialog; IdFTP1: TIdFTP; ADOQueryTemp: TADOQuery; ADOQueryCmd: TADOQuery; SaveDialog1: TSaveDialog; Image2: TImage; Panel2: TPanel; cxImage1: TcxImage; Panel1: TPanel; XFID: TEdit; CPName: TLabel; IMID: TLabel; N3: TMenuItem; Image1: TImage; Panel16: TPanel; Image11: TImage; Image22: TImage; N2: TMenuItem; procedure cxImage1DblClick(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure N1Click(Sender: TObject); procedure Image11DblClick(Sender: TObject); private lstPat: TStringList; procedure ReadINIFile10(); { Private declarations } public FileName,FIMID,FIMNO,FWBID:String; procedure Init(fFileName:string;fPicture:TJpegImage); procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); { Public declarations } end; implementation uses U_DataLink,U_Fun,U_HXKTJ,U_TJHXMX; {$R *.dfm} procedure TfrmSLT_TJ_CS.cxImage1DblClick(Sender: TObject); begin try frmTJHXMX:=TfrmTJHXMX.Create(Application); //230 152 with frmTJHXMX do begin Label9.Caption:=self.CPName.Caption; label8.Caption:=FIMNO; FileName:=self.FileName; frmTJHXMX.FIMID:=Self.FIMID; frmTJHXMX.FWBID:=Self.FWBID; if ShowModal=1 then begin end; end; finally frmTJHXMX.Free; end; end; procedure TfrmSLT_TJ_CS.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 TfrmSLT_TJ_CS.Init(fFileName:string;fPicture:TJpegImage); begin FileName:=trim(fFileName); cxImage1.Picture.Assign(fPicture); end; procedure TfrmSLT_TJ_CS.N2Click(Sender: TObject); begin if Application.MessageBox('确定要删除数据吗？','提示',32+4)<>IDYES then Exit; with ADOQueryCmd do begin Close; sql.Clear; sql.Add('UPdate Image_Info Set Valid=''N'',DelTime=getdate(),Deler='''+Trim(DName)+''',DelerCode='''+Trim(DCode)+''''); sql.Add('where IMID='''+trim(FIMID)+''''); sql.Add('UPdate Image_File Set Valid=''N'',DelTime=getdate(),Deler='''+Trim(DName)+''',DelerCode='''+Trim(DCode)+''''); sql.Add('where IMID='''+trim(FIMID)+''''); ExecSQL; end; frmHXKTJ.initimageSH(FWBID); end; procedure TfrmSLT_TJ_CS.N3Click(Sender: TObject); var IdFTP1: TIdFTP; fPrintFile,FFName:string; FInt:integer; begin if Application.MessageBox('原图下载需要等待时间，确定要查看原图吗？','提示',32+4)<>IDYES then Exit; try IdFTP1:=TIdFTP.Create(self); IdFTP1.Host :=PicSvr; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); except IdFTP1.Quit; IdFTP1.Free; Application.MessageBox('无法连接到文件服务器，请检查！', '提示', MB_ICONWARNING); Exit; end; fPrintFile:= ExtractFilePath(Application.ExeName)+'Photo\'; if not DirectoryExists(ExtractFileDir(FPrintFile)) then CreateDir(ExtractFileDir(fPrintFile)); FFName:=Trim(FileName); FFName:=fPrintFile+FFName; if not FileExists(FFName) then begin IdFTP1.Get('TJ\'+FileName,FFName); end; if IdFTP1.Connected then begin IdFTP1.Quit; IdFTP1.Free; end; ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL); end; procedure TfrmSLT_TJ_CS.N1Click(Sender: TObject); var i,j: Integer; AJpeg: TJPEGImage; myStream: TADOBlobStream; maxnoIMID,maxnoIFID,FWBID,ImageName:String; imageDate:TDate; begin lstPat := TStringList.Create; lstPat.Clear; if ODPat.Execute then begin lstPat.AddStrings(ODPat.Files); end; if lstPat.Count>1 then begin Application.MessageBox('不能选择多个图片!','提示',0); Exit; end else if lstPat.Count<>1 then begin Exit; end; begin try if IdFTP1.Connected then begin IdFTP1.Quit; end; ReadINIFile10(); server:=ReadINIFileStr('SYSTEMSET.INI','SERVER','服务器地址','127.0.0.1'); IdFTP1.Host :=server; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); except IdFTP1.Quit; Application.MessageBox('无法连接到文件服务器，请检查！', '提示', MB_ICONWARNING); Exit; end; end; Panel16.Visible:=True; Panel16.Refresh; imageDate:=SGetServerDate(ADOQueryTemp); try ADOQueryCmd.Connection.BeginTrans; for i := 0 to lstPat.Count - 1 do begin ImageName:=ExtractFileName(lstPat[i]); with ADOQueryCmd do begin Close; sql.Clear; sql.Add('select * from Image_Info where IMID='''+Trim(FIMID)+''''); Open; end; with ADOQueryCmd do begin Edit; FieldByName('ImageName').Value:=Trim(ImageName); FieldByName('Editer').Value:=Trim(DName); FieldByName('EditerCode').Value:=Trim(DCode); FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp); Post; end; AJpeg:=TJpegImage.Create(); AJpeg.LoadFromFile(ExtractFileName(lstPat[i])); if AJpeg.Width>450 then begin CreThumb(AJpeg,Image22,450, 619); end; if AJpeg.Width>150 then begin CreThumb(AJpeg,Image11,150, 206); end; with ADOQueryCmd do begin Close; sql.Clear; sql.Add('select * from Image_File where IMID='''+Trim(FIMID)+''' and IFType=''小'' '); Open; end; with ADOQueryCmd do begin Edit; myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('ImageFile')), bmWrite); AJpeg.Assign(Image11.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; FieldByName('Editer').Value:=Trim(DName); FieldByName('EditerCode').Value:=Trim(DCode); Post; end; with ADOQueryCmd do begin Close; sql.Clear; sql.Add('select * from Image_File where IMID='''+Trim(FIMID)+''' and IFType=''大'' '); Open; end; with ADOQueryCmd do begin Edit; myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('ImageFile')), bmWrite); AJpeg.Assign(image22.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; FieldByName('Editer').Value:=Trim(DName); FieldByName('EditerCode').Value:=Trim(DCode); Post; end; if IdFTP1.Connected then IdFTP1.Put(lstPat[i], 'TJ'+'\'+Trim(ImageName)); end; ADOQueryCmd.Connection.CommitTrans; Image11.Visible:=True; cxImage1.Visible:=False; Image11.Refresh; Image11.Align:=alClient; except Panel16.Visible:=False; ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('数据上传失败!','提示',0); Exit; end; Panel16.Visible:=False; end; procedure TfrmSLT_TJ_CS.CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); var Bitmap: TBitmap; Ratio: Double; ARect: TRect; //230 152 AHeight, AHeightOffset: Integer; AWidth, AWidthOffset: Integer; begin Bitmap := TBitmap.Create; try AWidth :=Width; AWidthOffset := 0; AHeight := Height; AHeightOffset := 0; 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, AJPeg); Image1.Picture.Assign(BitMap); finally Bitmap.Free; end; end; procedure TfrmSLT_TJ_CS.Image11DblClick(Sender: TObject); begin try frmTJHXMX:=TfrmTJHXMX.Create(Application); with frmTJHXMX do begin Label9.Caption:=self.CPName.Caption; label8.Caption:=FIMNO; FileName:=self.FileName; frmTJHXMX.FIMID:=Self.FIMID; frmTJHXMX.FWBID:=Self.FWBID; if ShowModal=1 then begin end; end; finally frmTJHXMX.Free; end; end; end.