unit SignOnlineReportsFrm; interface uses ProjectData, ReportManager, ReportConnection, ReportPrepare, PrintComTypeDefUnit, ADODB, DB, SignReports, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, sdIDTree, sdDB, ComCtrls, ExtCtrls, VirtualTrees, PrintCom, PrintComXML, MScrollBox, StdCtrls, Buttons, PNGButton, ieview, imageenview, jpeg; const crNext = -25; crPrevious = -26; offset = 150; type TSignOnlineReportsForm = class(TForm) tvReports: TTreeView; pnlBottom: TPanel; PreviewComXML: TPrintComXML; previewBox: TImage; msbReportsPreview: TMScrollBox; lblAlreadyUpload: TLabel; cbFillZero: TCheckBox; pnlPageControl: TPanel; btnPre: TButton; btnNext: TButton; lblPages: TLabel; pbGenerate: TPNGButton; ImageEnView1: TImageEnView; procedure FormShow(Sender: TObject); procedure tvReportsClick(Sender: TObject); procedure PreviewComXMLContentDisplay(var contentFontRec: TFontRec; dataType: Integer; isReading: Boolean; DrawType: Integer; isPrinting: Boolean); procedure PreviewComXMLCrossTabLabelShow(valIDX: Integer; var ExLeft, ExRight: Double; var isShow: Boolean; CrsTabShowType: Integer); procedure PreviewComXMLGetDataConnection(var ADOCon: TADOConnection); procedure PreviewComXMLGetDatasetEvent(DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet); procedure msbReportsPreviewMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure msbReportsPreviewMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure btnPreClick(Sender: TObject); procedure btnNextClick(Sender: TObject); procedure pbGenerateClick(Sender: TObject); procedure cbFillZeroClick(Sender: TObject); private FWebProjectID: Integer; FWebTenderID: Integer; FSignPhase: Integer; FProjectData: TProjectData; // 数据库管理 FReportCon: TReportConnection; // 报表数据准备 FReportDataPrepare: TReportPrepare; FPreviewList: TList; FCurPage: Integer; FTempPath: string; FPostedSignReports: TSignReports; procedure OnViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure OnViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); function SafeReportName(var AName: string): Boolean; procedure ExportReports(const AFileName: string); procedure ExportPdfReports(const AFileName: string); procedure LoadReportTemplates; procedure PreviewPage(AImage: TImage; APageIndex: Integer); procedure InitPageSettings(APrintCom: TPrintComXML); procedure InitFont(APrintCom: TPrintComXML); procedure InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML); procedure InitReportSettings(APrintCom: TPrintComXML; ATemplate: TTemplateNode = nil); procedure SaveAuditOpinion(ATemplate: TTemplateNode); procedure SaveReportInteractData(ATemplate: TTemplateNode); procedure LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML); procedure LoadTemplateAndDisplay(ATemplate: TTemplateNode); procedure SetCurPage(const Value: Integer); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Init(AProjNode: TsdIDTreeNode; ASignPhase: Integer); property ProjectData: TProjectData read FProjectData; property CurPage: Integer read FCurPage write SetCurPage; end; procedure SignOnline(AProjectNode: TsdIDTreeNode; ASignPhase: Integer); implementation uses UtilMethods, TemplateManagerHelper, Globals, AuditSelectFrm, ScFileArchiver, ZhAPI, PHPWebDm, imageenio, ReportPdfHelper, mProgressFrm, RenameSignReportFrm, Math; {$R *.dfm} procedure SignOnline(AProjectNode: TsdIDTreeNode; ASignPhase: Integer); var vSignForm: TSignOnlineReportsForm; begin vSignForm := TSignOnlineReportsForm.Create(nil); try vSignForm.Init(AProjectNode, ASignPhase); vSignForm.ShowModal; finally vSignForm.Free; end; end; { TSignOnlineReportsForm } destructor TSignOnlineReportsForm.Destroy; begin ClearObjects(FPreviewList); FPreviewList.Free; FReportCon.Free; FReportDataPrepare.Free; if Assigned(FProjectData) then FProjectData.Free; if DirectoryExists(FTempPath) then DeleteFileOrFolder(FTempPath); inherited; end; procedure TSignOnlineReportsForm.Init(AProjNode: TsdIDTreeNode; ASignPhase: Integer); function getTopParent(ANode: TsdIDTreeNode): TsdIDTreeNode; begin if Assigned(ANode.Parent) then Result := getTopParent(ANode.Parent) else Result := ANode; end; function getName(ANode: TsdIDTreeNode): string; begin Result := ANode.Rec.ValueByName('Name').AsString; end; begin FWebProjectID := GetTopParent(AProjNode).Rec.ValueByName('WebID').AsInteger; FWebTenderID := AProjNode.Rec.ValueByName('WebID').AsInteger; FSignPhase := ASignPhase; FProjectData := TProjectData.Create; FProjectData.OpenForSignOnline(GetMyProjectsFilePath + AProjNode.Rec.ValueByName('FileName').AsString, ASignPhase); FReportDataPrepare := TReportPrepare.Create(FProjectData); FReportCon := TReportConnection.Create(FProjectData); //Caption := Format('生成签署报表 %s-%s-第 %d 期', [getName(getTopParent(AProjectNode)), getName(AProjectNode), ASignPhase]); Caption := Format('生成签署报表 %s-第 %d 期', [getName(AProjNode), ASignPhase]); LoadReportTemplates; FTempPath := GetAppTempPath + IntToStr(AProjNode.ID) + '\'; CreateDirectoryInDeep(FTempPath); FPostedSignReports.LoadAllSignReports(PhPWeb.MeasureURL + 'sign/list', FWebTenderID, FSignPhase); end; procedure TSignOnlineReportsForm.LoadReportTemplates; var vHelper: TTemplateManagerHelper; begin vHelper := TTemplateManagerHelper.Create; try vHelper.ExportToTreeView(tvReports, ReportTemplateManager); finally vHelper.Free; end; end; procedure TSignOnlineReportsForm.FormShow(Sender: TObject); var vNode: TTreeNode; begin vNode := tvReports.Items.GetFirstNode; while Assigned(vNode) do begin vNode.Expand(True); vNode := vNode.getNextSibling; end; tvReports.Selected := tvReports.Items[0]; end; procedure TSignOnlineReportsForm.tvReportsClick(Sender: TObject); var vTemplate: TTemplateNode; begin if Assigned(tvReports.Selected) then begin vTemplate := TTemplateNode(tvReports.Selected.Data); pbGenerate.Visible := Assigned(vTemplate); cbFillZero.Visible := Assigned(vTemplate); pnlPageControl.Visible := Assigned(vTemplate); FPostedSignReports.LoadAllSignReports(PhPWeb.MeasureURL + 'sign/list', FWebTenderID, FSignPhase); lblAlreadyUpload.Visible := Assigned(vTemplate) and Assigned(FPostedSignReports.FindSignReport(FSignPhase, vTemplate.TemplateName)); ReportTemplateManager.Current := vTemplate; if Assigned(vTemplate) then LoadTemplateAndDisplay(vTemplate); tvReports.SetFocus; end; end; procedure TSignOnlineReportsForm.LoadTemplateAndDisplay(ATemplate: TTemplateNode); procedure WaringAndEmptyPreview(AStr: string); var OldBrushColor, OldPenColor: TColor; begin TipMessage(AStr, Handle); ClearObjects(FPreviewList); pnlPageControl.Visible := False; end; procedure ShowAllPages; const Indent = 5; var iPage: Integer; vPreviewImage: TImage; begin ClearObjects(FPreviewList); msbReportsPreview.HorzScrollBar.Range := 0; msbReportsPreview.HorzScrollBar.Position := 0; msbReportsPreview.VertScrollBar.Range := 0; msbReportsPreview.VertScrollBar.Position := 0; for iPage := 1 to PreviewComXML.TotalPages do begin vPreviewImage := TImage.Create(msbReportsPreview); vPreviewImage.Parent := msbReportsPreview; vPreviewImage.Top := (PreviewComXML.PrintHeight + Indent) * (iPage - 1); vPreviewImage.Left := 0; PreviewPage(vPreviewImage, iPage); FPreviewList.Add(vPreviewImage); end; msbReportsPreview.HorzScrollBar.Range := PreviewComXML.PrintWidth; msbReportsPreview.VertScrollBar.Range := PreviewComXML.PrintHeight * PreviewComXML.TotalPages + 10 * (PreviewComXML.TotalPages - 1); end; procedure ShowCurPages; var vPreviewImage: TImage; begin ClearObjects(FPreviewList); msbReportsPreview.HorzScrollBar.Position := 0; msbReportsPreview.VertScrollBar.Position := 0; vPreviewImage := TImage.Create(msbReportsPreview); vPreviewImage.Parent := msbReportsPreview; vPreviewImage.Top := 0; vPreviewImage.Left := 0; FPreviewList.Add(vPreviewImage); msbReportsPreview.HorzScrollBar.Range := PreviewComXML.ReportSize.X; msbReportsPreview.VertScrollBar.Range := PreviewComXML.ReportSize.Y; vPreviewImage.OnMouseMove := OnViewMouseMove; vPreviewImage.OnMouseDown := OnViewMouseDown; CurPage := 1; end; procedure PreviewTemplet(AIsShowAllPages: Boolean); begin try if AIsShowAllPages then ShowAllPages else ShowCurPages; pnlPageControl.Visible := not AIsShowAllPages; msbReportsPreview.SetFocus; except WaringAndEmptyPreview('当前报表显示可能存在问题,请与纵横客服中心联系:(0756)3850888。'); end; end; procedure LoadEmptyTempletAndDisplay; begin WaringAndEmptyPreview('报表无数据,请选择其他报表。'); end; begin // 交互表 if ATemplate.InteractFlag <> 0 then SaveReportInteractData(ATemplate); // 准备额外数据 if ATemplate.DataPrepareFlag <> 0 then FReportDataPrepare.PrepareData(ATemplate.DataPrepareFlag); FReportCon.RefreshConnection(ATemplate); Screen.Cursor := crHourGlass; try LoadTemplet(ATemplate, PreviewComXML); if PreviewComXML.TotalPages > 0 then PreviewTemplet(False) else LoadEmptyTempletAndDisplay; finally Screen.Cursor := crDefault; end; end; procedure TSignOnlineReportsForm.LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML); var RptArchiverObj: TReportArchiver; Mem: TMemoryStream; begin RptArchiverObj := TReportArchiver.Create; if ATemplate.IsMulti then RptArchiverObj.FileName := ATemplate.MultiFileNames[FProjectData.PhaseIndex] else RptArchiverObj.FileName := ATemplate.FileName; Mem := RptArchiverObj.Extract; try // 以下代码有顺序限制,不可修改,主要保证在不修改报表模板文件的基础上可以用户定制报表格式 // 私以为,原因在于这些设置修改后,并不能生效,需要保存再读取方可生效 // 读取报表模板 if not APrintCom.ReadReportStream(Mem) then Exit; // 将报表设置中的数据覆盖掉原模板的数据 InitReportSettings(APrintCom, ATemplate); // 保存 APrintCom.SaveToStream(Mem); // 再次读取,使报表设置中的设置生效 APrintCom.ReadReportStream(Mem); // ReadReportStream之后会将PreviewComXML的FillZero值赋为True,故再赋值一次 // To Do APrintCom.FillZero := cbFillZero.Checked; InitPageSettings(APrintCom); APrintCom.ReadDBData; APrintCom.AnalyseData(PreviewBox.Canvas); finally if Mem <> nil then Mem.Free; RptArchiverObj.Free; end; end; procedure TSignOnlineReportsForm.InitFont(APrintCom: TPrintComXML); procedure AssignFontRec(AFontRec: TFontRec; AFont: TFont); begin AFontRec.FontName := AFont.Name; AFontRec.FontHeight := Round(AFont.Size*4/3) ; AFontRec.FontBold := 400 + Integer(fsBold in AFont.Style)*200; AFontRec.FontItalic := Integer(fsItalic in AFont.Style); AFontRec.FontUnderLine := Integer(fsUnderLine in AFont.Style); end; procedure InitTitleFont; var TitleRec : PTitleRec; begin TitleRec := PreviewComXML.getTitleByID(1); if TitleRec <> nil then begin AssignFontRec(TitleRec.FontRec, ReportConfig.TitleFont); APrintCom.setTitleObj(TitleRec); end; end; procedure InitColumnFont; procedure InitColumnThick(AColumnRec: PColumnRec); begin if (ReportConfig.ReportCellLine > 0.2) then begin if (AColumnRec.LineInfo.LeftThick > 0.2) then AColumnRec.LineInfo.LeftThick := ReportConfig.ReportCellLine; if (AColumnRec.LineInfo.RightThick > 0.2) then AColumnRec.LineInfo.RightThick := ReportConfig.ReportCellLine; if (AColumnRec.LineInfo.TopThick > 0.2) then AColumnRec.LineInfo.TopThick := ReportConfig.ReportCellLine; if (AColumnRec.LineInfo.BottomThick > 0.2) then AColumnRec.LineInfo.BottomThick := ReportConfig.ReportCellLine; end; end; var i, j: Integer; ObjList: TList; ColumnRec : PColumnRec; AAR : PActiveAreaRec; SER : PShowElementRec; begin ObjList := TList.Create; try APrintCom.getAllColumnHeadObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin ColumnRec := ObjList[i]; AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont); InitColumnThick(ColumnRec); APrintCom.setColumnHeadTailObj(0, ColumnRec); end; APrintCom.getAllColumnTailObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin ColumnRec := ObjList[i]; AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont); InitColumnThick(ColumnRec); APrintCom.setColumnHeadTailObj(1,ColumnRec); end; APrintCom.getAllActAreaObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin AAR := ObjList[i]; for j := 0 to AAR.ElementList.Count - 1 do begin SER := AAR.ElementList[j]; if (SER.ElementType = 7) then begin ColumnRec := SER.Data; AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont); InitColumnThick(ColumnRec); APrintCom.setActShowElementObj(SER); end; end; end; finally ObjList.Free; end; end; procedure InitContentAndGatherFont; var i, j: Integer; ObjList: TList; FlowContentRec : PContentRec; CrossContentRec : PCrossContentRec; SumRec : PSumRec; begin ObjList := TList.Create; try // 设置表正文 APrintCom.getAllFlowShowContentObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin FlowContentRec := ObjList[i]; if not (FlowContentRec.Fixed) then begin AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont); APrintCom.setFlowContentObj(FlowContentRec); end; end; APrintCom.getAllBillShowContentObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin FlowContentRec := ObjList[i]; if not(FlowContentRec.Fixed) then begin AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont); APrintCom.setBillContentObj(FlowContentRec); end; end; APrintCom.getAllCrossContentObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin CrossContentRec := ObjList[i]; if not(CrossContentRec.CrossContent.Fixed) then begin AssignFontRec(CrossContentRec.CrossContent.FontRec, ReportConfig.ContentFont); APrintCom.setCrossContentObj(CrossContentRec); end; end; // 设置表合计 for i := 0 to 2 do begin APrintCom.getAllSumObjs(i,ObjList); for j := 0 to ObjList.Count - 1 do begin SumRec := ObjList[j]; AssignFontRec(SumRec.FontRec, ReportConfig.GatherFont); APrintCom.setSumObj(SumRec); end; end; finally ObjList.Free; end; end; procedure InitGridHeaderFont; var i: Integer; ObjList: TList; HeadTailRec : PHeadRec; begin ObjList := TList.Create; try APrintCom.getAllHeadObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin HeadTailRec := ObjList[i]; AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont); APrintCom.setHeadTailObj(0, HeadTailRec); end; APrintCom.getAllTailObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin HeadTailRec := ObjList[i]; AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont); APrintCom.setHeadTailObj(1, HeadTailRec); end; finally ObjList.Free; end; end; begin InitTitleFont; InitColumnFont; InitContentAndGatherFont; InitGridHeaderFont; end; procedure TSignOnlineReportsForm.InitPageSettings(APrintCom: TPrintComXML); begin // 设置页面大小 APrintCom.setPageSize(ReportConfig.PageSize); if ReportConfig.PageSize = 'A3' then APrintCom.PrintPageSizeIdx := DMPAPER_A3 else if ReportConfig.PageSize = 'A4' then APrintCom.PrintPageSizeIdx := DMPAPER_A4; // 设置边距 APrintCom.setEdge(0, '', ReportConfig.LeftEdge/10); APrintCom.setEdge(1, '', ReportConfig.RightEdge/10); APrintCom.setEdge(2, '', ReportConfig.UpEdge/10); APrintCom.setEdge(3, '', ReportConfig.DownEdge/10); end; procedure TSignOnlineReportsForm.InitPaperSettings( ATemplate: TTemplateNode; APrintCom: TPrintComXML); procedure InitRepBorderLine; var i: Integer; ObjList : TList; ShapeRec : PPicRec; begin ObjList := TList.Create; try APrintCom.getAllShapeObjs(1, ObjList); for i := 0 to ObjList.Count - 1 do begin ShapeRec := ObjList[i]; // 设置报表边框线粗 ShapeRec.PenWidth := ReportConfig.BorderLine; // 设置是否绘制报表边框横线 if (ShapeRec.ExArea.ExLeft <> ShapeRec.ExArea.ExRight) then begin if not ReportConfig.RepBorderUnderLine then ShapeRec.PenStyle := integer(psClear) else ShapeRec.PenStyle := integer(psSolid); end; // 设置是否绘制报表边框竖线 if (ShapeRec.ExArea.ExTop <> ShapeRec.ExArea.ExBottom) and ((ShapeRec.ExArea.ExLeft = 0) or (ShapeRec.ExArea.ExLeft = 100)) then begin //这里的判断条件是约定好的 if not ReportConfig.RepBorderVerLine then ShapeRec.PenStyle := integer(psClear) else ShapeRec.PenStyle := integer(psSolid) end; APrintCom.setShapeObj(ShapeRec); end; finally ObjList.Free; end; end; procedure InitRepCellLine; var i: Integer; ObjList : TList; ColumnRec : PColumnRec; FlowContentRec : PContentRec; CrossContentRec : PCrossContentRec; begin ObjList := TList.Create; try APrintCom.getAllFlowShowContentObjs(ObjList); // 设置报表表格横线 for i := 0 to ObjList.Count - 1 do begin FlowContentRec := ObjList[i]; FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth; FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth; APrintCom.setFlowContentObj(FlowContentRec); end; APrintCom.getAllCrossContentObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin CrossContentRec := ObjList[i]; CrossContentRec.CrossContent.LineInfo.TopThick := ReportConfig.CellHorLineWidth; CrossContentRec.CrossContent.LineInfo.BottomThick := ReportConfig.CellHorLineWidth; APrintCom.setCrossContentObj(CrossContentRec); end; // 设置报表表格竖线 APrintCom.getAllFlowShowContentObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin FlowContentRec := ObjList[i]; FlowContentRec.LineInfo.LeftThick := ReportConfig.CellVerLineWidth; FlowContentRec.LineInfo.RightThick := ReportConfig.CellVerLineWidth; // 如果设置无表格边框线,则两端的表格竖线线粗为0 if (not ReportConfig.RepBorderVerLine) then if (i = 0) then FlowContentRec.LineInfo.LeftThick := 0 else if (i = ObjList.Count - 1) then FlowContentRec.LineInfo.RightThick := 0; APrintCom.setFlowContentObj(FlowContentRec); end; APrintCom.getAllCrossContentObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin CrossContentRec := ObjList[i]; CrossContentRec.CrossContent.LineInfo.LeftThick := ReportConfig.CellVerLineWidth; CrossContentRec.CrossContent.LineInfo.RightThick := ReportConfig.CellVerLineWidth; ColumnRec := CrossContentRec.CrossContent.Column; //这里还要判断如果没有边框竖线的情况下,表格竖线边缘的线粗也为0 //前提是所属表栏最右位置位于边缘 if (not ReportConfig.RepBorderVerLine) and (ColumnRec<>nil) and ((ColumnRec.ExArea.ExRight = 100.0) or (ColumnRec.ExArea.ExLeft = 0.0)) then begin case CrossContentRec.CrossType of 0 : //交叉行 begin if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then CrossContentRec.CrossContent.LineInfo.LeftThick := 0; if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then CrossContentRec.CrossContent.LineInfo.RightThick := 0; end; 1 : //交叉列 begin if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then CrossContentRec.CrossContent.LineInfo.LeftThick := 0; if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then CrossContentRec.CrossContent.LineInfo.RightThick := 0; //(* if (CrossContentRec.CrossContent.isSpecialBorder) then begin if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then CrossContentRec.CrossContent.SpecialLineInfo.RightThick := 0; end; //*) end; 2 : //显示数据 begin if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then CrossContentRec.CrossContent.LineInfo.LeftThick := 0; if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then CrossContentRec.CrossContent.LineInfo.RightThick := 0; end; 3 : //固定LABEL begin if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then CrossContentRec.CrossContent.LineInfo.LeftThick := 0; if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then CrossContentRec.CrossContent.LineInfo.RightThick := 0; end; 4 : //序号 begin if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then CrossContentRec.CrossContent.LineInfo.LeftThick := 0; if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then CrossContentRec.CrossContent.LineInfo.RightThick := 0; end; 5 : //横向统计 begin if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then CrossContentRec.CrossContent.LineInfo.LeftThick := 0; if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then CrossContentRec.CrossContent.LineInfo.RightThick := 0; end; end; end; APrintCom.setCrossContentObj(CrossContentRec); end; finally ObjList.Free; end; end; procedure InitOtherArea; procedure SetPTRBorder(PTR : PTextRec); procedure SetLeftRightBorder; begin if PTR.ExArea.ExLeft = 0.0 then begin if BorderWidth = 0.0 then PTR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth; end; if PTR.ExArea.ExRight = 100.0 then begin if BorderWidth = 0.0 then PTR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth end; end; procedure SetHorLine; begin if (PTR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then PTR.LineInfo.TopThick := ReportConfig.CellHorLineWidth; if (PTR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then PTR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth; end; begin SetLeftRightBorder; SetHorLine; end; procedure SetPCRBorder(PCR : PColumnRec); procedure SetLeftRightBorder; begin if PCR.ExArea.ExLeft = 0.0 then begin if BorderWidth = 0.0 then PCR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth end; if PCR.ExArea.ExRight = 100.0 then begin if BorderWidth = 0.0 then PCR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth; end; end; procedure SetVerLine; begin if PCR.ExArea.ExLeft = 0.0 then PCR.LineInfo.LeftThick := ReportConfig.CellVerLineWidth; if PCR.ExArea.ExRight = 100.0 then PCR.LineInfo.RightThick := ReportConfig.CellVerLineWidth; end; procedure SetHorLine; begin if (PCR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then PCR.LineInfo.TopThick := ReportConfig.CellHorLineWidth; if (PCR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then PCR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth; end; begin SetLeftRightBorder; SetVerLine; SetHorLine; end; var i,k : integer; ObjList : TList; ActAreaRec : PActiveAreaRec; PSR : PShowElementRec; begin ObjList := TList.Create; try ActAreaRec := nil; PreviewComXML.getAllActAreaObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin ActAreaRec := ObjList[i]; if (ActAreaRec.ShowType < 0) or (ActAreaRec.ShowType > 2) then Continue; if not Assigned(ActAreaRec.ElementList) then Continue; for k := 0 to ActAreaRec.ElementList.Count - 1 do begin PSR := PShowElementRec(ActAreaRec.ElementList[k]); case PSR.ElementType of 0..2 : SetPTRBorder(PSR.Data); //文本,参数,字段,表栏 7 : SetPCRBorder(PSR.Data) //Column end; APrintCom.setActShowElementObj(PSR); end; end; finally ObjList.Free; end; end; begin if not Assigned(ATemplate) or (ATemplate.SelfFormat = 0) then begin InitFont(APrintCom); // 各类字体 InitRepBorderLine; // 报表边框 InitRepCellLine; // 报表表格 InitOtherArea; // 活动区域 end; end; procedure TSignOnlineReportsForm.SaveAuditOpinion( ATemplate: TTemplateNode); var SelectForm: TAuditSelctForm; begin SelectForm := TAuditSelctForm.Create(FProjectData, ATemplate); try if SelectForm.ShowModal = mrOk then SelectForm.SaveAuditData; finally SelectForm.Free; end; end; procedure TSignOnlineReportsForm.SaveReportInteractData( ATemplate: TTemplateNode); begin case ATemplate.InteractFlag of 1: SaveAuditOpinion(ATemplate); end; end; procedure TSignOnlineReportsForm.InitReportSettings( APrintCom: TPrintComXML; ATemplate: TTemplateNode); begin InitPageSettings(APrintCom); InitPaperSettings(ATemplate, APrintCom); APrintCom.ShowBackgroundMark := FProjectData.ProjProperties.ShowReportShading; APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShading; if FProjectData.ProjProperties.ReportShowState then begin if FProjectData.ProjProperties.ReportShowStateWithoutReply and ((FProjectData.ProjProperties.AuditStatus = -1) or (FProjectData.PhaseIndex < FProjectData.ProjProperties.PhaseCount)) then APrintCom.ShowBackgroundMark := False else APrintCom.ShowBackgroundMark := True; end else APrintCom.ShowBackgroundMark := False; APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShowStateText; end; procedure TSignOnlineReportsForm.PreviewComXMLContentDisplay( var contentFontRec: TFontRec; dataType: Integer; isReading: Boolean; DrawType: Integer; isPrinting: Boolean); begin if ReportConfig.ContentIsNarrow then begin if (isReading) then begin begin contentFontRec.FontName := 'Arial Narrow'; contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3; end; end else begin if (DrawType = 3) or (DrawType = 5) then begin contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3); end else if (isPrinting) then begin contentFontRec.FontName := 'Arial Narrow'; contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 7 div 6; end else begin contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3; end; end; end; end; procedure TSignOnlineReportsForm.PreviewComXMLCrossTabLabelShow( valIDX: Integer; var ExLeft, ExRight: Double; var isShow: Boolean; CrsTabShowType: Integer); var field : PFieldRec; begin if (CrsTabShowType = -1) then exit; field := PreviewComXML.getFieldByID(6); if (field <> nil) then begin if (field.DataLen > valIDX) and (valIDX >= 0) then begin if (field.Value[valIDX] = 1.5) then begin case CrsTabShowType of 1 : begin isShow := false; end; 2 : begin ExLeft := 0; ExRight := 100; end; 3 : begin // end else begin // end; end; end; end; end; end; procedure TSignOnlineReportsForm.PreviewComXMLGetDataConnection( var ADOCon: TADOConnection); begin ADOCon := FReportCon.Connection; end; procedure TSignOnlineReportsForm.PreviewComXMLGetDatasetEvent( DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet); begin if DatasetInfo.ID = 0 then ADataSet := MemoryReportManager.GetSqlResultDataSet(ReportTemplateManager.Current.InteractInfo.Sql, FProjectData) else ADataset := MemoryReportManager.GetMemoryDataSet(DatasetInfo.ID, FProjectData); end; procedure TSignOnlineReportsForm.PreviewPage(AImage: TImage; APageIndex: Integer); begin if Assigned(AImage) then begin AImage.Height := PreviewComXML.ReportSize.Y; AImage.Picture.Bitmap.Height := PreviewComXML.ReportSize.Y; AImage.Width := PreviewComXML.ReportSize.X; AImage.Picture.Bitmap.Width := PreviewComXML.ReportSize.X; PreviewComXML.PrintPreviewCanvas(APageIndex, 0, AImage.Canvas, False); end; end; constructor TSignOnlineReportsForm.Create(AOwner: TComponent); procedure LoadCursor(AIndex: Integer; const AFileName: string); var rst: Integer; begin rst := LoadCursorFromFile(PChar(AFileName)); if rst <> 0 then Screen.Cursors[AIndex] := rst; end; begin inherited; FPreviewList := TList.Create; LoadCursor(crPrevious, GetAppFilePath + 'PreviousPage.cur'); LoadCursor(crNext, GetAppFilePath + 'NextPage.cur'); FPostedSignReports := TSignReports.Create; end; procedure TSignOnlineReportsForm.msbReportsPreviewMouseWheelDown( Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin SendMessage(TMScrollBox(Sender).Handle, WM_VSCROLL, SB_LINEDOWN, 0); end; procedure TSignOnlineReportsForm.msbReportsPreviewMouseWheelUp( Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin SendMessage(TMScrollBox(Sender).Handle, WM_VSCROLL, SB_LINEUP, 0); end; procedure TSignOnlineReportsForm.ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin SendMessage(TScrollBox(Sender).Handle, WM_VSCROLL, SB_LINEDOWN, 0); end; procedure TSignOnlineReportsForm.ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); begin SendMessage(TScrollBox(Sender).Handle, WM_VSCROLL, SB_LINEUP, 0); end; procedure TSignOnlineReportsForm.ExportReports(const AFileName: string); procedure ExportReportPage(APage: Integer; const APageFileName: string); var bmp: TBitmap; img: TJPEGImage; begin bmp := TBitmap.Create; img := TJPEGImage.Create; try bmp.Height := PreviewComXML.ReportSize.Y; bmp.Width := PreviewComXML.ReportSize.X; PreviewComXML.PrintPreviewCanvas(APage, 0, bmp.Canvas, False); img.Assign(bmp); img.CompressionQuality := 100; img.Compress; img.SaveToFile(APageFileName); finally bmp.Free; img.Free; end; end; var ATempFolder: String; i: Integer; begin ATempFolder := GenerateTempFolder(GetTempFilePath); for i := 1 to PreviewComXML.TotalPages do begin ExportReportPage(i, Format('%s\%d.jpg', [ATempFolder, i])); end; ZipFolder(ATempFolder, AFileName); end; procedure TSignOnlineReportsForm.btnPreClick(Sender: TObject); begin if CurPage > 1 then CurPage := CurPage - 1 else WarningMessage('已经是最前了'); end; procedure TSignOnlineReportsForm.btnNextClick(Sender: TObject); begin if CurPage < PreviewComXML.TotalPages then CurPage := CurPage + 1 else WarningMessage('已经是最后了'); end; procedure TSignOnlineReportsForm.SetCurPage(const Value: Integer); begin FCurPage := Value; PreviewPage(TImage(FPreviewList.Items[0]), FCurPage); lblPages.Caption := Format('%d/%d', [FCurPage, PreviewComXML.TotalPages]); end; procedure TSignOnlineReportsForm.pbGenerateClick(Sender: TObject); var sReportName, sZipFile, sPdfFile, sErrorMessage: string; vInFields, vInValues: array [0..5] of string; vUpFileFields, vUpFileNames: array [0..1] of string; begin if PreviewComXML.TotalPages > 200 then begin TipMessage('该报表不支持在线签署功能。'); Exit; end; sReportName := ReportTemplateManager.Current.TemplateName; if SafeReportName(sReportName) then begin CreateProgress('上传中,请等待...'); vInFields[0] := 'project'; vInValues[0] := IntToStr(FWebProjectID); vInFields[1] := 'tender'; vInValues[1] := IntToStr(FWebTenderID); vInFields[2] := 'phaseno'; vInValues[2] := IntToStr(FSignPhase); vInFields[3] := 'name'; vInValues[3] := sReportName; vInFields[4] := 'ownuid'; vInValues[4] := IntToStr(PHPWeb.UserID); vInFields[5] := 'widhei'; vInValues[5] := Format('%d_%d', [Round(PreviewComXML.ReportSizeDou.X * 10), Round(PreviewComXML.ReportSizeDou.Y * 10)]); vUpFileFields[0] := 'upfile'; vUpFileNames[0] := GetTempFileName(FTempPath, '.zip'); ExportReports(vUpFileNames[0]); vUpFileFields[1] := 'upspdf'; vUpFileNames[1] := GetTempFileName(FTempPath, '.pdf'); PdfHelper.ExportAllPages(PreviewComXML, vUpFileNames[1]); if PHPWeb.UploadFiles('sign/create', vInFields, vInValues, vUpFileFields, vUpFileNames, sErrorMessage) then begin FPostedSignReports.AddSignReport(FSignPhase, ReportTemplateManager.Current.TemplateName, 234); lblAlreadyUpload.Visible := True; CloseProgress; TipMessage('上传完成。'); end else begin CloseProgress; WarningMessage(Format('%s, 上传数据失败,请重试。', [sErrorMessage])); end; end; end; procedure TSignOnlineReportsForm.OnViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if (X < offset) and (CurPage > 1) then begin TControl(Sender).Cursor := crPrevious; end else if (X > TControl(Sender).Width - 150) and (CurPage < PreviewComXML.TotalPages) then begin TControl(Sender).Cursor := crNext; end else begin TControl(Sender).Cursor := crDefault; end; end; procedure TSignOnlineReportsForm.OnViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (X < offset) and (CurPage > 1) then begin CurPage := CurPage - 1; end else if (X > TControl(Sender).Width - 150) and (CurPage < PreviewComXML.TotalPages) then begin CurPage := CurPage + 1; end; end; procedure TSignOnlineReportsForm.ExportPdfReports(const AFileName: string); procedure ExportReportPage(APage: Integer; const APageFileName: string); var imgEn: TImageEnView; begin imgEn := TImageEnView.Create(nil); try imgEn.Visible := False; imgEn.Parent := Self; imgEn.IO.CreatePDFFile(APageFileName); imgEn.Bitmap.Height := PreviewComXML.ReportSize.X; imgEn.Bitmap.Width := PreviewComXML.ReportSize.Y; PreviewComXML.PrintPreviewCanvas(APage, 0, imgEn.Bitmap.Canvas, False); imgEn.IO.SaveToPDF; finally imgEn.Free; end; end; var ATempFolder: String; i: Integer; begin ATempFolder := GenerateTempFolder(GetTempFilePath); for i := 1 to PreviewComXML.TotalPages do begin ExportReportPage(i, Format('%s\%d.pdf', [ATempFolder, i])); end; ZipFolder(ATempFolder, AFileName); end; function TSignOnlineReportsForm.SafeReportName(var AName: string): Boolean; var sOrgName: string; iCount: Integer; bHasQuest: Boolean; begin Result := False; sOrgName := AName; iCount := 0; FPostedSignReports.LoadAllSignReports(PhPWeb.MeasureURL + 'sign/list', FWebTenderID, FSignPhase); while Assigned(FPostedSignReports.FindSignReport(FSignPhase, AName)) do begin Inc(iCount); AName := Format('%s(%d)', [sOrgName, iCount]); end; Result := SameText(sOrgName, AName); if not Result then Result := QuestRenameSignReport(AName, FSignPhase); end; procedure TSignOnlineReportsForm.cbFillZeroClick(Sender: TObject); begin PreviewComXML.FillZero := cbFillZero.Checked; PreviewPage(TImage(FPreviewList.Items[0]), FCurPage); end; end.