unit U_SLT_TJ_SX; 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_SX = class(TFrame) ADOQuery1: TADOQuery; ADOQuery2: TADOQuery; PopupMenu1: TPopupMenu; ODPat: TOpenDialog; IdFTP1: TIdFTP; ADOQueryTemp: TADOQuery; ADOQueryCmd: TADOQuery; ADOQuery3: TADOQuery; ADOQuery4: TADOQuery; SaveDialog1: TSaveDialog; Image2: TImage; Panel2: TPanel; cxImage1: TcxImage; Panel1: TPanel; TJMLNo: TLabel; Button1: TButton; WBID: TEdit; Panel3: TPanel; Panel4: TPanel; Panel5: TPanel; Panel6: TPanel; SH: TLabel; ZW: TLabel; YW: TLabel; N3: TMenuItem; N1: TMenuItem; Memo1: TMemo; procedure cxImage1DblClick(Sender: TObject); procedure N1Click(Sender: TObject); procedure N3Click(Sender: TObject); procedure cxImage1Click(Sender: TObject); procedure Memo1Click(Sender: TObject); procedure N2Click(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,FIMID,FImagePath,FTJHX,FIMNO,FWBID,FTJTPID: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_LRTJ,U_BPZdy_ColTJ; {$R *.dfm} procedure TfrmSLT_TJ_SX.Init(fCYID:string;fFileName:string;fPicture:TJpegImage); begin CYID:=trim(fCYID); FileName:=trim(fFileName); lstPat := TStringList.Create; cxImage1.Picture.Assign(fPicture); end; procedure TfrmSLT_TJ_SX.cxImage1DblClick(Sender: TObject); var IdFTP1: TIdFTP; FPath,FFName:string; FInt:integer; maxno:string; j,i:Integer; begin frmMLManage_LRTJ.Panel16.Refresh; frmMLManage_LRTJ.Panel16.Visible:=true; 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+'.jpg'; if DirectoryExists(ExtractFileDir(FFName)) then DeleteFile(FFName); if FileExists(FFName) then begin FInt:=1; end; if FInt<>1 then IdFTP1.Get('TJ\'+FileName,FFName); if IdFTP1.Connected then begin IdFTP1.Quit; IdFTP1.Free; end; ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL); frmMLManage_LRTJ.Panel16.Visible:=false; end; procedure TfrmSLT_TJ_SX.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_SX.SaveImageOther(); begin end; procedure TfrmSLT_TJ_SX.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_TJ_SX.N1Click(Sender: TObject); begin with ADOQuery3 do begin Close; SQL.Clear; SQL.Add('select * from Image_Info '); sql.Add('where IMID='''+trim(FIMID)+''' and Valid=''Y'''); Open; end; with ADOQuery3 do begin if ADOQuery3.IsEmpty=False then begin frmMLManage_LRTJ.TJNo.Text:=Trim(FieldByName('TJHX').asstring); frmMLManage_LRTJ.TJCol.Text:=Trim(FieldByName('TJCol').asstring); frmMLManage_LRTJ.TJColNo.Text:=Trim(FieldByName('TJColNo').asstring); frmMLManage_LRTJ.TJPTID.Text:=Trim(FieldByName('TJPTID').asstring); frmMLManage_LRTJ.TJCPID.Text:=Trim(FieldByName('TJCPID').asstring); frmMLManage_LRTJ.TJTPID.Text:=Trim(FieldByName('TJTPID').asstring); frmMLManage_LRTJ.TJNote.Text:=Trim(FieldByName('TJNote').asstring); frmMLManage_LRTJ.ShowImage(); end; end; with frmMLManage_LRTJ do begin N4.Click; SaveImage1(Trim(Self.FTJTPID)); initimageSH(); end; end; procedure TfrmSLT_TJ_SX.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+'.jpg'; if DirectoryExists(ExtractFileDir(FFName)) then DeleteFile(FFName); if FileExists(FFName) then begin FInt:=1; end; if FInt<>1 then IdFTP1.Get('TJ\'+FileName,FFName); if IdFTP1.Connected then begin IdFTP1.Quit; IdFTP1.Free; end; ShellExecute(Handle, 'open',PChar(FFName),'', '', SW_SHOWNORMAL); end; procedure TfrmSLT_TJ_SX.cxImage1Click(Sender: TObject); var FTJNo:string; begin if Formid<>'' then begin if Memo1.Text='' then begin Memo1.Text:='√'; memo1.Color:=clRed; end else begin Memo1.Text:=''; memo1.Color:=clWindow; end; end else begin with ADOQuery3 do begin Close; SQL.Clear; SQL.Add('select * from Image_Info '); sql.Add('where IMID='''+trim(FIMID)+''' and Valid=''Y'''); Open; end; with ADOQuery3 do begin if ADOQuery3.IsEmpty=False then begin frmMLManage_LRTJ.TJNo.Text:=Trim(FieldByName('TJHX').asstring); frmMLManage_LRTJ.TJCol.Text:=Trim(FieldByName('TJCol').asstring); frmMLManage_LRTJ.TJColNo.Text:=Trim(FieldByName('TJColNo').asstring); //frmMLManage_LRTJ.HXType.Text:=Trim(FieldByName('TJHXType').asstring); //frmMLManage_LRTJ.TJGYName.Text:=Trim(FieldByName('TJGYName').asstring); frmMLManage_LRTJ.TJPTID.Text:=Trim(FieldByName('TJPTID').asstring); frmMLManage_LRTJ.TJCPID.Text:=Trim(FieldByName('TJCPID').asstring); frmMLManage_LRTJ.TJTPID.Text:=Trim(FieldByName('TJTPID').asstring); frmMLManage_LRTJ.TJNote.Text:=Trim(FieldByName('TJNote').asstring); frmMLManage_LRTJ.ShowImage(); end; end; frmMLManage_LRTJ.Panel6.Visible:=true; end; {frmBPZDY_ColTJ:=TfrmBPZDY_ColTJ.Create(self); with frmBPZDY_ColTJ do begin FIMID:=Trim(Self.FIMID); if ShowModal=1 then begin //initimageSH(); end; free; end;} end; procedure TfrmSLT_TJ_SX.Memo1Click(Sender: TObject); begin if Memo1.Text='' then begin Memo1.Text:='√'; memo1.Color:=clRed; end else begin Memo1.Text:=''; memo1.Color:=clWindow; end; end; procedure TfrmSLT_TJ_SX.N2Click(Sender: TObject); begin with ADOQuery3 do begin Close; SQL.Clear; SQL.Add('delete from Image_Info '); sql.Add('where IMID='''+trim(FIMID)+''' and Valid=''Y'''); execsql; end; application.MessageBox('删除成功','提示'); frmMLManage_LRTJ.initimageSH(); end; end.