unit U_CPInPutDML; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, cxGridLevel, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGrid, cxMemo, cxRichEdit, ComCtrls, cxContainer, cxTextEdit, cxMaskEdit, cxButtonEdit, StdCtrls, ToolWin, DBClient, ADODB, ExtCtrls, BtnEdit, cxCalendar,StrUtils, cxDropDownEdit,jpeg, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, cxPC, cxGridCustomPopupMenu, cxGridPopupMenu, cxGroupBox, cxCheckBox, RM_Dataset, RM_System, RM_Common, RM_Class, RM_GridReport,IniFiles; type TfrmCPInPutDML = class(TForm) ToolBar1: TToolBar; TBClose: TToolButton; ADOTemp: TADOQuery; ADOCmd: TADOQuery; ADOQuery1: TADOQuery; TBSave: TToolButton; Label26: TLabel; CDS_PRT: TClientDataSet; RM1: TRMGridReport; Panel3: TPanel; Panel6: TPanel; Panel5: TPanel; Label12: TLabel; Label14: TLabel; Label15: TLabel; Label16: TLabel; Label2: TLabel; ZIKZ: TEdit; ZIMF: TEdit; ZICF: TEdit; Panel8: TPanel; Button1: TButton; ODPat: TOpenDialog; Image1: TImage; IdFTP1: TIdFTP; SaveDialog1: TSaveDialog; Label1: TLabel; ToolButton1: TToolButton; Label4: TLabel; ZIID: TEdit; adoqueryPicture: TADOQuery; Panel1: TPanel; RMDBMain: TRMDBDataSet; Label5: TLabel; Edit1: TEdit; ZIGY: TMemo; Label7: TLabel; Label8: TLabel; ZIName: TEdit; Label9: TLabel; Note: TMemo; ADOQueryCmd: TADOQuery; Image11: TImage; procedure TBCloseClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure TBSaveClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ToolButton1Click(Sender: TObject); procedure Image1DblClick(Sender: TObject); procedure Image2DblClick(Sender: TObject); private lstPat,lstPat2:TStringList; FangXiang1,FangXiang2:String; procedure InitData(); procedure SaveImage(maxnoWB:String;FIMNO:String); procedure ReadINIFile10(); function SaveData():Boolean; function StrFenHang(FStr:String;var FHStr:String):Boolean; { Private declarations } public canshu1:String; PState,CopyInt:Integer; FMainId:String; { Public declarations } end; var frmCPInPutDML: TfrmCPInPutDML; implementation uses U_DataLink,U_ZDYHelp,U_RTFun,U_ZHCPBigTP; {$R *.dfm} procedure TfrmCPInPutDML.TBCloseClick(Sender: TObject); begin Close; end; procedure TfrmCPInPutDML.InitData(); var jpg:TJpegImage; myStream: TADOBlobStream; FStr:string; begin with ADOQuery1 do begin Close; sql.Clear; sql.Add(' select * '); sql.Add(' from ZH_CP_Info '); sql.Add(' where ZIID='''+Trim(FMainId)+''''); Open; end; SCSHDataNew(ADOQuery1,Panel5,9); SCSHDataNew(ADOQuery1,Panel5,2); SCSHDataNew(ADOQuery1,Panel3,9); //StrFenHang(ZIGY.Text,FStr); // ZIGY.Text:=FStr; with adoqueryPicture do begin Close; sql.Clear; sql.Add('select * from Image_Info A'); sql.Add(' inner join Image_File B on A.IMID=B.IMID'); sql.Add(' and A.WBID='''+Trim(FMainId)+''''); sql.Add(' and isnull(A.IMNo,'''')=''图片'' and A.Valid=''Y'' '); Open; end; if adoqueryPicture.IsEmpty=False then begin Fstr:=Trim(adoqueryPicture.fieldbyname('ImageName').AsString); Edit1.Text:=Copy(FStr,1,Length(FStr)-4); jpg:=TJpegImage.Create(); myStream:=tadoblobstream.Create(tblobfield(adoqueryPicture.fieldbyname('ImageFile')),bmread); jpg.LoadFromStream(myStream); Image1.Picture.Assign(jpg); Image1.Width:=adoqueryPicture.fieldbyname('ImageWidth').Value; Image1.Height:=adoqueryPicture.fieldbyname('ImageHeight').Value; if Trim(adoqueryPicture.fieldbyname('FangXiang').AsString)='垂直' then begin Image1.Top:=1; Image1.Left:=Round((Panel6.Width-Image1.Width)/2); end else begin Image1.Left:=1; Image1.Top:=Round((Panel6.Height-Image1.Height)/2); end; Image1.Visible:=True; end; if TBSave.Visible=False then begin Button1.Visible:=False; ZIMF.Color:=ZIID.Color; ZIKZ.Color:=ZIID.Color; ZICF.Color:=ZIID.Color; ZIName.Color:=ZIID.Color; ZIGY.Color:=ZIID.Color; Note.Color:=ZIID.Color; end; end; procedure TfrmCPInPutDML.FormShow(Sender: TObject); begin InitData(); end; function TfrmCPInPutDML.SaveData():Boolean; var maxno:String; begin Result:=False; try ADOCmd.Connection.BeginTrans; ///保存主表 if Trim(FMainId)='' then begin if GetLSNoHZ(ADOCmd,maxno,'D','ZH_CP_Info',4,1,1)=False then begin ADOCmd.Connection.RollbackTrans; Application.MessageBox('取最大号失败!','提示',0); Exit; end; end else begin maxno:=Trim(FMainId); end; with ADOCmd do begin Close; sql.Clear; SQL.Add('select * from ZH_CP_Info where ZIId='''+Trim(maxno)+''''); Open; end; with ADOCmd do begin if Trim(FMainId)='' then begin Append; end else begin Edit; end; FieldByName('ZIId').Value:=Trim(maxno); FieldByName('ZIType').Value:='单面料'; if Trim(FMainId)='' then begin FieldByName('ZIIdYS').Value:=Trim(maxno); FieldByName('Filler').Value:=Trim(DName); FieldByName('FillerCode').Value:=Trim(DCode); FieldByName('Valid').Value:='Y'; FieldByName('ZIDate').Value:=SGetServerDate(ADOTemp); end else begin FieldByName('Editer').Value:=Trim(DName); FieldByName('EditerCode').Value:=Trim(DCode); FieldByName('EditTime').Value:=SGetServerDateTime(ADOTemp); end; RTSetsavedata(ADOCmd,'ZH_CP_Info',Panel5,2); RTSetsavedata(ADOCmd,'ZH_CP_Info',Panel3,9); Post; end; FMainId:=Trim(maxno); if Trim(Image1.Hint)<>'' then begin SaveImage(maxno,'图片'); end; {if Trim(Image2.Hint)<>'' then begin SaveImage(maxno,'图片'); end; } ADOCmd.Connection.CommitTrans; FMainId:=Trim(maxno); Result:=True; except Result:=False; ADOCmd.Connection.RollbackTrans; Application.MessageBox('保存失败！','提示',0); end; end; procedure TfrmCPInPutDML.TBSaveClick(Sender: TObject); begin ToolBar1.SetFocus; if Trim(ZIMF.Text)='' then begin Application.MessageBox('门幅不能为空!','提示',0); Exit; end; if Trim(ZIKZ.Text)='' then begin Application.MessageBox('克重不能为空!','提示',0); Exit; end; if Trim(ZICF.Text)='' then begin Application.MessageBox('成份不能为空!','提示',0); Exit; end; Panel1.Visible:=True; Panel1.Refresh; if SaveData() then begin Panel1.Visible:=False; Application.MessageBox('保存成功！','提示',0); ModalResult:=1; end; end; procedure TfrmCPInPutDML.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 TfrmCPInPutDML.SaveImage(maxnoWB:string;FIMNO:String); var ImagePath,ImagName,MaxNo,MaxNoFile:String; AJpeg:TJPEGImage; myStream:TADOBlobStream; begin try if Trim(FIMNO)='图片' then begin ImagePath:=Image1.Hint; ImagName:=Image1.Hint; end;{ else if Trim(FIMNO)='图片' then begin ImagePath:=Image2.Hint; ImagName:=Image2.Hint; end; } AJpeg:=TJpegImage.Create(); with ADOCmd do begin Close; sql.Clear; SQL.Add('UPdate Image_File Set Valid=''N'' '); sql.Add(' where IMID=(select IMID from Image_Info'); Sql.Add('where WBID='''+Trim(maxnoWB)+''' and Valid=''Y'' and IMNO='''+Trim(FIMNO)+''')'); ExecSQL; end; with ADOCmd do begin Close; sql.Clear; SQL.Add('UPdate Image_Info Set Editer='''+Trim(DName)+''',EditerCode='''+Trim(DCode)+''',EditTime=getdate()'); sql.Add(',Valid=''N'' where WBID='''+Trim(maxnoWB)+''' and Valid=''Y'' and IMNO='''+Trim(FIMNO)+''' '); ExecSQL; end; if GetLSNo(ADOCmd,MaxNo,'IM','Image_Info',4,1)=False then begin ADOCmd.Connection.RollbackTrans; Application.MessageBox('取图片信息最大号失败！','提示',0); Exit; end; with ADOCmd do begin Close; SQL.Clear; SQL.Add('select * from Image_Info where 1=2'); Open; end; with ADOCmd do begin Append; FieldByName('IMID').Value:=Trim(MaxNo); FieldByName('IMNo').Value:=FIMNO; FieldByName('WBID').Value:=Trim(maxnoWB); FieldByName('ImageName').Value:=Trim(ImagName); FieldByName('ImagePath').Value:=Trim(MaxNo)+Trim(ImagName); FieldByName('ImageDate').Value:=SGetServerDate(ADOTemp); Fieldbyname('ImageType').value:=Trim('YP'); Fieldbyname('Valid').value:=Trim('Y'); Post; end; if GetLSNo(ADOCmd,MaxNoFile,'IF','Image_File',4,1)=False then begin ADOCmd.Connection.RollbackTrans; Application.MessageBox('取图片文件最大号失败！','提示',0); Exit; end; with ADOCmd do begin close; sql.Clear; sql.Add(' select * from Image_File where 1=2'); open; end; with ADOCmd do begin Append; FieldByName('IMID').Value:=Trim(MaxNo); FieldByName('IFID').Value:=Trim(MaxNoFile); Fieldbyname('Valid').value:=Trim('Y'); if Trim(FIMNO)='图片' then begin FieldByName('ImageWidth').Value:=Image1.Width; FieldByName('ImageHeight').Value:=Image1.Height; FieldByName('FangXiang').Value:=FangXiang1; end; FieldByName('IFType').Value:='小'; myStream := TADOBlobStream.Create(TBlobField(ADOCmd.FieldByName('ImageFile')), bmWrite); if Trim(FIMNO)='图片' then begin AJpeg.Assign(Image1.Picture.Graphic); end; AJpeg.SaveToStream(myStream); myStream.Free; Post; end; with ADOCmd do begin Append; FieldByName('IMID').Value:=Trim(MaxNo); FieldByName('IFID').Value:=Trim(MaxNoFile)+'D'; Fieldbyname('Valid').value:=Trim('Y'); if Trim(FIMNO)='图片' then begin FieldByName('ImageWidth').Value:=Image11.Width; FieldByName('ImageHeight').Value:=Image11.Height; FieldByName('FangXiang').Value:=FangXiang1; end; FieldByName('IFType').Value:='大'; myStream := TADOBlobStream.Create(TBlobField(ADOCmd.FieldByName('ImageFile')), bmWrite); if Trim(FIMNO)='图片' then begin AJpeg.Assign(Image11.Picture.Graphic); end; AJpeg.SaveToStream(myStream); myStream.Free; Post; end; 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; if IdFTP1.Connected then begin if Trim(FIMNO)='图片' then begin IdFTP1.Put(lstPat[0], 'YP'+'\'+Trim(MaxNo)+Trim(ImagName)); end; end; if IdFTP1.Connected then IdFTP1.Quit; except ADOCmd.Connection.RollbackTrans; Application.MessageBox('图片保存失败！','提示',0); end; end; Procedure TfrmCPInPutDML.FormClose(Sender: TObject; var Action: TCloseAction); begin ModalResult:=1; end; procedure TfrmCPInPutDML.Button1Click(Sender: TObject); var AJpeg:TJPEGImage; Bitmap,Bitmap11: TBitmap; ARect,ARect11: TRect; TPHeight, AHeightOffset: Integer; TPWidth, AWidthOffset: Integer; WZShuiPing,WZChuiZhi:Integer; WZFlag:String; FHFStr:String; begin lstPat.Clear; if ODPat.Execute then begin lstPat.AddStrings(ODPat.Files); end else begin Exit; end; if lstPat.Count>1 then begin lstPat.Clear; Application.MessageBox('不能上传多个图片!','提示',0); Exit; end else if lstPat.Count<1 then begin Exit; end; Panel1.Visible:=True; Panel1.Refresh; Panel6.Color:=clBtnFace; Panel6.Hint:=''; AJpeg:=TJpegImage.Create(); AJpeg.LoadFromFile(ExtractFileName(ODPat.FileName)); Image1.Hint:=ExtractFileName(ODPat.FileName); TPWidth:=AJpeg.Width; TPHeight:=AJpeg.Height; Bitmap := TBitmap.Create; Bitmap11 := TBitmap.Create; Bitmap.Width :=Panel6.Width-2; Bitmap.Height :=Round(Panel6.Width/TPWidth*TPHeight); if Bitmap.Height>Panel6.Height then begin WZFlag:='垂直'; Bitmap.Height:=Panel6.Height-2; Bitmap.Width :=Round(Panel6.Height/TPHeight*TPWidth); end; Bitmap11.Width:=Bitmap.Width*2; Bitmap11.Height:=Bitmap.Height*2; Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height)); ARect := Rect(0, 0, Bitmap.Width, Bitmap.Height); Bitmap.Canvas.StretchDraw(ARect, AJPeg); Image1.Height:=Bitmap.Height; Image1.Width:=Bitmap.Width; Image1.Picture.Assign(BitMap); if Trim(WZFlag)='垂直' then begin Image1.Top:=1; Image1.Left:=Round((Panel6.Width-Image1.Width)/2); end else begin Image1.Left:=1; Image1.Top:=Round((Panel6.Height-Image1.Height)/2); end; FangXiang1:=WZFlag; Image1.Visible:=True; Bitmap11.Canvas.FillRect(Rect(0, 0, Bitmap11.Width, Bitmap11.Height)); ARect11 := Rect(0, 0, Bitmap11.Width, Bitmap11.Height); Bitmap11.Canvas.StretchDraw(ARect11, AJPeg); Image11.Height:=Bitmap11.Height; Image11.Width:=Bitmap11.Width; Image11.Picture.Assign(BitMap11); Edit1.Text:=Copy(Image1.Hint,1,Length(Image1.Hint)-4); //StrFenHang(Edit1.Text,FHFStr); //ZIGY.Text:=FHFStr; Panel1.Visible:=False; end; function TfrmCPInPutDML.StrFenHang(FStr:string;var FHStr:String):Boolean; var i,j:Integer; LSStr:String; begin Result:=False; FStr:=Trim(FStr); FHStr:=''; j:=1; i:=Pos(' ',FStr); while i>0 do begin if j=1 then begin LSStr:=Copy(FStr,1,i-1); //'1234 5678 456' FHStr:='1:'+LSStr; end else begin LSStr:=Copy(FStr,1,i-1); if Trim(LSStr)='' then begin Fstr:=Copy(Fstr,i+1,Length(Fstr)-i); end else FHStr:=FHStr+#13+#10+inttostr(j)+':'+LSStr; end; if Trim(LSStr)<>'' then begin j:=j+1; Fstr:=Copy(Fstr,i+1,Length(Fstr)-i); end; i:=Pos(' ',FStr); end; if j=1 then begin FHStr:=FStr; end else begin if Trim(FStr)<>'' then begin FHStr:=FHStr+#13+#10+inttostr(j)+':'+FStr; end; end; Result:=True; end; procedure TfrmCPInPutDML.FormCreate(Sender: TObject); begin lstPat := TStringList.Create; lstPat2 := TStringList.Create; end; procedure TfrmCPInPutDML.ToolButton1Click(Sender: TObject); var fPrintFile,Txt,fImagePath,maxno:string; i,j:Integer; Moudle: THandle; Makebar:TMakebar; Mixtext:TMixtext; begin if Trim(FMainId)='' then begin Application.MessageBox('没有保存数据，不能打印!','提示',0); Exit; end; fPrintFile:= ExtractFilePath(Application.ExeName) + 'Report\展会产品标签85.rmf'; if FileExists(fPrintFile)=False then begin Application.MessageBox(PChar('没有找'+ExtractFilePath(Application.ExeName)+'Report\展会产品标签85.rmf'),'提示',0); exit; end; with ADOTemp do begin Close; SQL.Clear; sql.Add(' select A.* ,C.ImageFile'); sql.Add(' from ZH_CP_Info A'); sql.Add(' inner join Image_Info B on A.ZIID=B.WBID'); sql.Add(' inner join Image_File C on B.IMID=C.IMID'); sql.Add(' where A.ZIID='''+Trim(FMainId)+''''); sql.Add(' and B.IMNO=''图片'' and A.Valid=''Y'' and B.Valid=''Y'' and C.Valid=''Y'' '); Open; end; SCreateCDS20(ADOTemp,CDS_PRT); SInitCDSData20(ADOTemp,CDS_PRT); try ADOQueryCmd.Connection.BeginTrans; if GetLSNo(ADOQueryCmd,maxno,'DYKC','ZH_CP_Info_KC',4,1,)=False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取样品打印最大号失败!','提示',0); Exit; end; with ADOQueryCmd do begin Close; sql.Clear; SQL.Add('select * from ZH_CP_Info_KC where DYId='''+Trim(maxno)+''''); Open; end; with ADOQueryCmd do begin Append; FieldByName('ZIId').Value:=Trim(FMainId); FieldByName('DYId').Value:=Trim(maxno); FieldByName('Filler').Value:=Trim(DName); FieldByName('FillerCode').Value:=Trim(DCode); FieldByName('Valid').Value:='Y'; Post; end; with ADOQueryCmd do begin Close; sql.Clear; sql.Add('Update ZH_CP_Info_KC Set DYXH=isnull((select max(DYXH) from ZH_CP_Info_KC A '); sql.Add(' where A.ZIID='''+Trim(FMainId)+'''),0)+1 '); sql.Add(' where DYID='''+Trim(maxno)+''''); ExecSQL; end; ADOQueryCmd.Connection.CommitTrans; except ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('保存打印流水号异常！','提示',0); Exit; end; try Moudle:=LoadLibrary('MakeQRBarcode.dll'); @Makebar:=GetProcAddress(Moudle,'Make'); @Mixtext:=GetProcAddress(Moudle,'MixText'); Txt:=Trim(maxno); fImagePath:=ExtractFilePath(Application.ExeName)+'image\temp.bmp'; if not DirectoryExists(pchar(ExtractFilePath(Application.ExeName)+'image')) then CreateDirectory(pchar(ExtractFilePath(Application.ExeName)+'image'),nil); if FileExists(fImagePath) then DeleteFile(fImagePath); Makebar(pchar(Txt),Length(Txt),3,3,0,PChar(fImagePath),3); except application.MessageBox('二维码生成失败！','提示信息',MB_ICONERROR); exit; end; RMVariables['QRBARCODE']:=fImagePath; RMVariables['DYID']:=maxno; RM1.LoadFromFile(fPrintFile); //RM1.ShowReport; RM1.PrintReport; end; procedure TfrmCPInPutDML.Image1DblClick(Sender: TObject); begin if Trim(FMainId)='' then begin Application.MessageBox('没有保存数据，不能查看大图!','提示',0); Exit; end; try frmZHCPBigTP:=TfrmZHCPBigTP.Create(Application); with frmZHCPBigTP do begin frmZHCPBigTP.FMainId:=Self.FMainId; frmZHCPBigTP.FIMNO:='图片'; if ShowModal=1 then begin end; end; finally frmZHCPBigTP.Free; end; end; procedure TfrmCPInPutDML.Image2DblClick(Sender: TObject); begin if Trim(FMainId)='' then begin Application.MessageBox('没有保存数据，不能查看大图!','提示',0); Exit; end; try frmZHCPBigTP:=TfrmZHCPBigTP.Create(Application); with frmZHCPBigTP do begin frmZHCPBigTP.FMainId:=Self.FMainId; frmZHCPBigTP.FIMNO:='图片'; if ShowModal=1 then begin end; end; finally frmZHCPBigTP.Free; end; end; end.