unit U_HXKYH; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, ToolWin, ComCtrls, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls, cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls, cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu,IniFiles, cxButtonEdit, BtnEdit, cxTL, cxMaskEdit, cxInplaceContainer, cxDBTL,U_SLT_TJ, cxTLData, cxContainer, cxCurrencyEdit, cxCheckBox, cxSplitter,jpeg,Math, Menus, cxCalendar, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP; type TfrmHXKYH = class(TForm) ADOQueryMain: TADOQuery; ADOQueryTemp: TADOQuery; ADOQueryCmd: TADOQuery; DataSource1: TDataSource; Ord_TJ: TClientDataSet; ADOConnection1: TADOConnection; ThreeImgList: TImageList; DataSource2: TDataSource; Panel2: TPanel; Panel4: TPanel; DataSource4: TDataSource; ADOQueryTree: TADOQuery; Order_Tree: TClientDataSet; cxGridPopupMenu1: TcxGridPopupMenu; cxStyleRepository1: TcxStyleRepository; cxStyle1: TcxStyle; cxStyleRepository2: TcxStyleRepository; cxStyle2: TcxStyle; cxSplitter1: TcxSplitter; ToolBar2: TToolBar; TSH: TToolButton; ToolBar1: TToolBar; adoqueryPicture: TADOQuery; ScrollBox2: TScrollBox; THB: TToolButton; TGB: TToolButton; ADOQuery1: TADOQuery; cxDBTreeList1: TcxDBTreeList; VColumn2: TcxDBTreeListColumn; SaveDialog1: TSaveDialog; ODPat: TOpenDialog; IdFTP1: TIdFTP; Panel1: TPanel; Image2: TImage; Image1: TImage; Panel16: TPanel; Panel3: TPanel; ScrollBox3: TPanel; BTLP: TButton; BTNP: TButton; LBCPAP: TLabel; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormShow(Sender: TObject); procedure TSHClick(Sender: TObject); procedure THBClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure TGBClick(Sender: TObject); procedure cxDBTreeList1DblClick(Sender: TObject); procedure BTLPClick(Sender: TObject); procedure BTNPClick(Sender: TObject); procedure cxDBTreeList1Click(Sender: TObject); private JS:integer; lstPat: TStringList; AJpeg: TJPEGImage; procedure initTree(); procedure CreThumb(AJPeg:TJPEGImage;Image1:TImage;Width, Height: Integer); procedure ReadINIFile10(); { Private declarations } public my,mz:integer; procedure initimageSH(FWBID:String); { Public declarations } end; var frmHXKYH: TfrmHXKYH; Mach1: array of TfrmSLT_TJ; implementation uses U_DataLink,U_RTFun, U_BPZdy_HXK,U_CPTypePB,U_FileUp_TP ,U_FileUp,U_FileUp_PB,U_FileUp_TPSH,U_SLT_BF1; {$R *.dfm} procedure TfrmHXKYH.initTree(); begin with ADOQueryTree do begin Close; SQL.Clear; SQL.Add('select *'); sql.Add(',JS=(select Max(A.CPlevel) from CP_TypeTJ A)'); sql.Add(', Case when isnull(CPNo,'''')<>'''' and CPlevel=''2'' then RTrim(CPNo)+''/''+CPName else CPName end as CP '); SQL.Add('from CP_TypeTJ order by CPlevel,CPOrder,CPName'); Open; end; SCreateCDS20(ADOQueryTree,Order_Tree); SInitCDSData20(ADOQueryTree,Order_Tree); JS:=Order_Tree.fieldbyname('JS').AsInteger; cxDBTreeList1.Items[0].Expand(true); end; procedure TfrmHXKYH.initimageSH(FWBID:String); var i,j,p,x:integer; jpg:TJpegImage; myStream: TADOBlobStream; begin j:=length(Mach1); if j>0 then begin for i:=0 to j-1 do begin Mach1[i].free; end; end; SetLength(Mach1, 0); try with adoqueryPicture do begin close; sql.Clear; sql.Add(' exec P_View_Image :WBID,:ImageType,:IFType,:Ye,:YeQty '); Parameters.ParamByName('WBID').Value:=Trim(FWBID); Parameters.ParamByName('ImageType').Value:='TJ'; Parameters.ParamByName('IFType').Value:='小'; Parameters.ParamByName('Ye').Value:=my; Parameters.ParamByName('YeQty').Value:=18; open; end; j:=adoqueryPicture.RecordCount; if j<1 then exit; adoqueryPicture.DisableControls; adoqueryPicture.First; SetLength(Mach1, j); with adoqueryPicture do begin First; i:=0; x:=0; //列 p:=0; //行 while not eof do begin if (i<18*my) and (i>=18*(my-1)) then begin jpg:=TJpegImage.Create(); myStream:=tadoblobstream.Create(tblobfield(adoqueryPicture.fieldbyname('ImageFile')),bmread); jpg.LoadFromStream(myStream); if (i-18*(my-1))<6*(p+1) then begin end else begin p:=p+1; end; Mach1[i]:=TfrmSLT_TJ.Create(Self); Mach1[i].Name:=trim(adoqueryPicture.fieldbyname('IMID').AsString); //Mach1[i].CPName.Caption:=trim(adoqueryPicture.fieldbyname('CPName').AsString); Mach1[i].IMID.Caption:=trim(adoqueryPicture.fieldbyname('IMNO').AsString); Mach1[i].Parent:=ScrollBox2; Mach1[I].Left:=0+(x-6*p)*158; Mach1[I].Top:=p*236; Mach1[I].FIMID:=trim(adoqueryPicture.fieldbyname('IMID').AsString); Mach1[I].FIMNO:=trim(adoqueryPicture.fieldbyname('IMNO').AsString); Mach1[I].FWBID:=Trim(FWBID); if triM(adoqueryPicture.fieldbyname('IMID').AsString)<>'' then begin Mach1[i].Init(adoqueryPicture.fieldbyname('ImageName').AsString,jpg); end; Mach1[i].cxImage1.Visible:=True; Mach1[i].cxImage1.AutoSize:=True; Mach1[i].cxImage1.Properties.Stretch:=True; Mach1[i].cxImage1.Align:=alClient; Mach1[i].Image11.Visible:=False; x:=x+1; end; i:=i+1; Next; end; end; adoqueryPicture.EnableControls; finally jpg.free; end; end; procedure TfrmHXKYH.FormCreate(Sender: TObject); begin try with ADOConnection1 do begin Connected:=false; ConnectionString:=DConString; Connected:=true; end; except; frmHXKYH.Free; end; lstPat := TStringList.Create; end; procedure TfrmHXKYH.FormClose(Sender: TObject; var Action: TCloseAction); begin Finalize(Mach1); Action:=caFree; end; procedure TfrmHXKYH.FormShow(Sender: TObject); begin initTree(); ToolBar1.Visible:=false; TSH.Visible:=false; end; procedure TfrmHXKYH.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 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 TfrmHXKYH.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 TfrmHXKYH.TSHClick(Sender: TObject); var i,j: Integer; AJpeg: TJPEGImage; myStream: TADOBlobStream; maxnoIMID,maxnoIMNO,maxnoIFID,FWBID,ImageName:String; imageDate:TDate; begin lstPat.Clear; if ODPat.Execute then begin lstPat.AddStrings(ODPat.Files); end; if lstPat.Count > 0 then 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 else begin Exit; end; Panel16.Visible:=True; Panel16.Refresh; FWBID:=Trim(Self.Order_Tree.fieldbyname('CPID').AsString); imageDate:=SGetServerDate(ADOQueryTemp); try ADOQueryCmd.Connection.BeginTrans; for i := 0 to lstPat.Count - 1 do begin ImageName:=ExtractFileName(lstPat[i]); if GetLSNoHZ(ADOQueryCmd,maxnoIMID,'TJ','Image_Info',4,1,0)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取图片ID失败!','提示',0); Exit; end; if GetLSNoHZ(ADOQueryCmd,maxnoIMNO,'','Image_InfoTJ',4,0,0)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取图片NO失败!','提示',0); Exit; end; with ADOQueryCmd do begin Close; sql.Clear; sql.Add('select * from Image_Info where 1=2'); Open; end; with ADOQueryCmd do begin Append; FieldByName('IMID').Value:=Trim(maxnoIMID); FieldByName('IMNO').Value:=Trim(maxnoIMNO); FieldByName('WBID').Value:=Trim(FWBID); FieldByName('ImageType').Value:='TJ'; FieldByName('ImageDate').Value:=imageDate; FieldByName('ImageName').Value:=Trim(ImageName); FieldByName('Filler').Value:=Trim(DName); FieldByName('FillerCode').Value:=Trim(DCode); FieldByName('Valid').Value:='Y'; Post; end; AJpeg:=TJpegImage.Create(); AJpeg.LoadFromFile(ExtractFileName(lstPat[i])); if AJpeg.Width>450 then begin CreThumb(AJpeg,Image2,450, 619); end; if AJpeg.Width>150 then begin CreThumb(AJpeg,Image1,150, 206); end; with ADOQueryCmd do begin Close; sql.Clear; sql.Add('select * from Image_File where 1=2'); Open; end; with ADOQueryCmd do begin Append; FieldByName('IMID').Value:=Trim(maxnoIMID); FieldByName('IFID').Value:=Trim(maxnoIMID)+'X'; FieldByName('IFType').Value:='小'; myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('ImageFile')), bmWrite); AJpeg.Assign(Image1.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; FieldByName('Filler').Value:=Trim(DName); FieldByName('FillerCode').Value:=Trim(DCode); FieldByName('Valid').Value:='Y'; Post; end; with ADOQueryCmd do begin Append; FieldByName('IMID').Value:=Trim(maxnoIMID); FieldByName('IFID').Value:=Trim(maxnoIMID)+'D'; FieldByName('IFType').Value:='大'; myStream := TADOBlobStream.Create(TBlobField(ADOQueryCmd.FieldByName('ImageFile')), bmWrite); AJpeg.Assign(Image2.Picture.Graphic); AJpeg.SaveToStream(myStream); myStream.Free; FieldByName('Filler').Value:=Trim(DName); FieldByName('FillerCode').Value:=Trim(DCode); FieldByName('Valid').Value:='Y'; Post; end; if IdFTP1.Connected then IdFTP1.Put(lstPat[i], 'TJ'+'\'+Trim(ImageName)); end; ADOQueryCmd.Connection.CommitTrans; except Panel16.Visible:=False; ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('数据上传失败!','提示',0); Exit; end; Panel16.Visible:=False; initimageSH(FWBID); end; procedure TfrmHXKYH.THBClick(Sender: TObject); begin InitTree(); end; procedure TfrmHXKYH.FormDestroy(Sender: TObject); begin frmHXKYH:=nil; end; procedure TfrmHXKYH.TGBClick(Sender: TObject); begin Close; end; procedure TfrmHXKYH.cxDBTreeList1DblClick(Sender: TObject); begin ModalResult:=1; end; procedure TfrmHXKYH.BTLPClick(Sender: TObject); begin if my<=1 then exit; my:=my-1; LBCPAP.Caption:=IntToStr(my)+'/'+inttostr(mz); initimageSH(Order_Tree.fieldbyname('CPID').AsString); end; procedure TfrmHXKYH.BTNPClick(Sender: TObject); begin if my>=mz then exit; my:=my+1; LBCPAP.Caption:=IntToStr(my)+'/'+inttostr(mz); initimageSH(Order_Tree.fieldbyname('CPID').AsString); end; procedure TfrmHXKYH.cxDBTreeList1Click(Sender: TObject); var FLevel:integer; begin Panel3.Visible:=true; Panel3.Refresh; cxDBTreeList1.Enabled:=false; my:=1; if Order_Tree.fieldbyname('CPlevel').AsInteger<>3 then begin TSH.Visible:=false; end else TSH.Visible:=True; initimageSH(Trim(Order_Tree.fieldbyname('CPID').AsString)); if adoqueryPicture.IsEmpty=False then begin mz:=Ceil(adoqueryPicture.fieldbyname('GS').AsInteger/18); end else begin mz:=1; end; LBCPAP.Caption:=IntToStr(my)+'/'+IntToStr(mz); cxDBTreeList1.Enabled:=True; Panel3.Visible:=false; end; end.