unit U_SLT; 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 = class(TFrame) ADOQuery1: TADOQuery; ADOQuery2: TADOQuery; PopupMenu1: TPopupMenu; N1: TMenuItem; ODPat: TOpenDialog; IdFTP1: TIdFTP; ADOQueryTemp: TADOQuery; ADOQueryCmd: TADOQuery; ADOQuery3: TADOQuery; ADOQuery4: TADOQuery; SaveDialog1: TSaveDialog; Image2: TImage; Panel2: TPanel; cxImage1: TcxImage; Panel1: TPanel; Label2: TLabel; Label1: TLabel; Label3: TLabel; ColorName: TEdit; Button1: TButton; WBID: TEdit; ColorNameEng: TEdit; ColorNo: TcxCurrencyEdit; Panel3: TPanel; Panel4: TPanel; Panel5: TPanel; Panel6: TPanel; N2: TMenuItem; SH: TLabel; ZW: TLabel; YW: TLabel; N3: TMenuItem; procedure cxImage1Click(Sender: TObject); procedure cxImage1DblClick(Sender: TObject); procedure ColorNoKeyPress(Sender: TObject; var Key: Char); procedure ColorNameKeyPress(Sender: TObject; var Key: Char); procedure Button1Click(Sender: TObject); procedure N1Click(Sender: TObject); procedure N2Click(Sender: TObject); procedure N3Click(Sender: TObject); private CYID,FileName:string; lstPat: TStringList; AJpeg: TJPEGImage; procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); procedure ReadINIFile10(); procedure SaveImageOther(); // procedure Sharpen(SrcBmp:TBitmap); { Private declarations } public SKID,FXFID:string; Formid:string; procedure Init(fCYID:string;fFileName:string;fPicture:TJpegImage); { Public declarations } end; implementation uses U_DataLink,U_Fun,U_BPZdy_LRSHK,U_MLManage_LRRS_ColCX; {$R *.dfm} procedure TfrmSLT.Init(fCYID:string;fFileName:string;fPicture:TJpegImage); begin CYID:=trim(fCYID); FileName:=trim(fFileName); lstPat := TStringList.Create; //Panel1.Caption:=FileName; cxImage1.Picture.Assign(fPicture); end; procedure TfrmSLT.cxImage1Click(Sender: TObject); begin if Formid='' then begin if ColorNo.Visible=false then begin ColorNo.Visible:=True; end else begin ColorNo.Visible:=false; end; if ColorName.Visible=false then begin ColorName.Visible:=true; end else begin ColorName.Visible:=false; end; if ColorNameEng.Visible=false then begin ColorNameEng.Visible:=true; end else begin ColorNameEng.Visible:=false; end; end; end; procedure TfrmSLT.cxImage1DblClick(Sender: TObject); var IdFTP1: TIdFTP; FPath,FFName:string; FInt:integer; maxno:string; j,i:Integer; begin if Formid='1' then begin self.Visible:=false; if TScrollBox(Self.Parent).ParentCtl3D then begin frmMLManage_LRRS_CX.imagePL(1); end else begin frmMLManage_LRRS_CX.imagePL(2); end; end; if Formid='' then begin 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; FPath:='D:\Right1209\'; if not DirectoryExists(ExtractFileDir(FPath)) then CreateDir(ExtractFileDir(FPath)); FFName:=Trim(FileName); FFName:=FPath+FFName; if DirectoryExists(ExtractFileDir(FFName)) then DeleteFile(FFName); if FileExists(FFName) then begin FInt:=1; end; if FInt<>1 then IdFTP1.Get('YP\'+FileName,FFName); if IdFTP1.Connected then begin IdFTP1.Quit; IdFTP1.Free; end; ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL); end; end; procedure TfrmSLT.ColorNoKeyPress(Sender: TObject; var Key: Char); begin if key=#13 then begin ColorName.SetFocus; end; end; procedure TfrmSLT.ColorNameKeyPress(Sender: TObject; var Key: Char); begin if key=#13 then begin Button1.SetFocus; end; end; procedure TfrmSLT.Button1Click(Sender: TObject); var maxno:string; begin if ColorNo.Text='' then begin application.MessageBox('色号不能为空','提示'); exit; end; with ADOQuery1 do begin close; sql.Clear; sql.Add('select * from SH_Base where WBID='''+trim(WBID.Text)+''''); open; end; with ADOQuery1 do begin if IsEmpty then begin if GetLSNo(ADOQuery2,MaxNo,'SH','SH_Base',4,1)=False then begin Application.MessageBox('取图片最大号失败!','提示',0); Exit; end; Append; FieldByName('SHID').Value:=Trim(MaxNo); FieldByName('SKID').Value:=Trim(SKID); FieldByName('filler').Value:=Trim(DName); FieldByName('Valid').Value:='Y'; end else begin edit; FieldByName('editer').Value:=Trim(DName); FieldByName('Edittime').Value:=now; end; FieldByName('ColorNo').Value:=Trim(ColorNo.Text); RTSetsavedata(ADOQuery1,'SH_Base',Self.Panel1,2); post; end; //Application.MessageBox('保存成功','提示'); end; procedure TfrmSLT.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.SaveImageOther(); var AJpeg: TJPEGImage; myStream: TADOBlobStream; ImgMaxNo:String; i,j: Integer; PatFile: String; FTPPath,FConNo,FTFID: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(self.Name)+''''); open; end; with ADOQueryCmd do begin Edit; FieldByName('Editer').Value:=Trim(DName); FieldByName('EditTime').Value:=SGetServerDateTime(ADOQueryTemp); AJpeg.Assign(Image2.Picture.Graphic); //CreThumb(AJpeg,Image1,160, 120); myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('FilesOther')), bmWrite); AJpeg.Assign(Image2.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; Post; end; end; procedure TfrmSLT.CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); var Bitmap: TBitmap; Ratio: Double; ARect: TRect; AHeight, AHeightOffset: Integer; AWidth, AWidthOffset: Integer; begin Bitmap := TBitmap.Create; try Ratio := AJPeg.Width /AJPeg.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, AJPeg); Image1.Picture.Assign(BitMap); finally Bitmap.Free; end; end; procedure TfrmSLT.N1Click(Sender: TObject); var i,j: Integer; PatFile: String; FTPPath,FConNo,MaxNo:string; AJpeg: TJPEGImage; begin lstPat.Clear; if ODPat.Execute then begin lstPat.AddStrings(ODPat.Files); end; if lstPat.Count > 0 then begin try ReadINIFile10(); server:=ReadINIFileStr('SYSTEMSET.INI','SERVER','服务器地址','127.0.0.1'); IdFTP1.Host :=server;//PicSvr; IdFTP1.Username := 'three'; IdFTP1.Password := '641010'; IdFTP1.Connect(); except; IdFTP1.Quit; Application.MessageBox('无法连接到文件服务器,请检查!', '提示', MB_ICONWARNING); Exit; end; end; AJpeg:=TJpegImage.Create(); with ADOQueryTemp do begin Close; SQL.Clear; SQL.Add('select filename from XD_File where XFID='''+Trim(self.Name)+''' '); SQL.Add('and filetype=''YP'''); //ShowMessage(sql.Text); Open; end; Image2.Picture.LoadFromFile(ODPat.FileName); AJpeg.Assign(Image2.Picture.Graphic); CreThumb(AJpeg,Image2,216, 187); try ADOQueryCmd.Connection.BeginTrans; for i := 0 to lstPat.Count - 1 do begin PatFile := ExtractFileName(lstPat[i]); PatFile:=ADOQueryTemp.fieldbyname('Filename').AsString; //ShowMessage(PatFile); if IdFTP1.Connected then begin IdFTP1.Put(lstPat[i], 'YP'+'\'+Trim(PatFile)); with ADOQueryCmd do begin Close; SQL.Clear; SQL.Add('select * from XD_File where XFID='''+Trim(self.Name)+''''); Open; end; with ADOQueryCmd do begin edit; FieldByName('filename').Value:=Trim(PatFile); FieldByName('FileDate').Value:=SGetServerDate(ADOQueryTemp); fieldbyname('FileType').value:=Trim('YP'); Post; end; end; end; SaveImageOther(); ADOQueryCmd.Connection.CommitTrans; except; ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('图片上传失败!','提示',0); end; if IdFTP1.Connected then IdFTP1.Quit; if i>0 then //Application.MessageBox(PChar(inttostr(i)+'个文件上传成功!'),'提示',0); //frmBPZDY_LRSHK.initimageSH(); end; procedure TfrmSLT.N2Click(Sender: TObject); begin with ADOQueryCmd do begin Close; sql.Clear; SQL.Add(' Delete XD_File where XFID='''+Trim(self.Name)+''''); SQL.Add(' Delete TP_File where TFID='''+Trim(self.Name)+''' '); ExecSQL; end; //frmBPZDY_LRSHK.initimageSH(); end; procedure TfrmSLT.N3Click(Sender: TObject); var IdFTP1: TIdFTP; FPath,FFName:string; FInt:integer; begin 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; FPath:='D:\Right1209\'; if not DirectoryExists(ExtractFileDir(FPath)) then CreateDir(ExtractFileDir(FPath)); FFName:=Trim(FileName); FFName:=FPath+FFName; if DirectoryExists(ExtractFileDir(FFName)) then DeleteFile(FFName); if FileExists(FFName) then begin FInt:=1; end; if FInt<>1 then IdFTP1.Get('YP\'+FileName,FFName); if IdFTP1.Connected then begin IdFTP1.Quit; IdFTP1.Free; end; ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL); end; end.