unit ReportsFrm; interface // 导出PDF须定义该编译指令 {$DEFINE cplPrint} // 导出Excel须定义该编译指令 {$DEFINE cplOutputToExcelRange} uses ProjectData, ScFileArchiver, ReportManager, ConditionalDefines, PrintComTypeDefUnit, ADODB, DB, ReportPrepare, AuditSelectFrm, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, PrintCom, PrintComXML, ExtCtrls, ExTreeView, ImgList, dxBarExtItems, dxBar, ComCtrls, ToolWin, StdCtrls; type TReportsForm = class(TForm) xmReports: TdxBarManager; xlbPrint: TdxBarLargeButton; xlbToExcel: TdxBarLargeButton; xlbToPDF: TdxBarLargeButton; xlbRealSize: TdxBarLargeButton; xlbOnePage: TdxBarLargeButton; xlbTwoPage: TdxBarLargeButton; xlbFourPage: TdxBarLargeButton; xcbPages: TdxBarCombo; xlbFirstPage: TdxBarLargeButton; xlbPrePage: TdxBarLargeButton; xlbNextPage: TdxBarLargeButton; xlbLastPage: TdxBarLargeButton; xcbStartPage: TdxBarCombo; xcbEndPage: TdxBarCombo; xlbSetup: TdxBarLargeButton; xlbClose: TdxBarLargeButton; xlbPrintCurPage: TdxBarLargeButton; dxcciSafePrint: TdxBarControlContainerItem; ilstLarge: TImageList; pnlReportsList: TPanel; extvReport: TExTreeView; sprReportPreview: TSplitter; sbReportsPreview: TScrollBox; PreviewBox: TImage; PreviewComXML: TPrintComXML; ilstTree: TImageList; pnlTopButton: TPanel; tobaTemplateManager: TToolBar; tbImportSrt: TToolButton; tbExportSrt: TToolButton; tbDeleteSrt: TToolButton; ilstTemplateContorl: TImageList; pnlPaperSize: TPanel; rdbtnA3: TRadioButton; rdbtnA4: TRadioButton; chkFillZero: TCheckBox; dxcciPageSize: TdxBarControlContainerItem; pnlExcelMode: TPanel; chkExcelMode: TCheckBox; chkExcel2010: TCheckBox; dxcciExcelMode: TdxBarControlContainerItem; pnlReports: TPanel; procedure PreviewComXMLGetDataConnection(var ADOCon: TADOConnection); procedure xlbRealSizeClick(Sender: TObject); procedure xlbOnePageClick(Sender: TObject); procedure xlbTwoPageClick(Sender: TObject); procedure xlbFourPageClick(Sender: TObject); procedure xlbFirstPageClick(Sender: TObject); procedure xlbPrePageClick(Sender: TObject); procedure xlbNextPageClick(Sender: TObject); procedure xlbLastPageClick(Sender: TObject); procedure xcbPagesChange(Sender: TObject); procedure xlbPrintCurPageClick(Sender: TObject); procedure xcbStartPageChange(Sender: TObject); procedure xlbPrintClick(Sender: TObject); procedure xlbToPDFClick(Sender: TObject); procedure xlbToExcelClick(Sender: TObject); procedure extvReportClick(Sender: TObject); procedure xlbCloseClick(Sender: TObject); procedure tbImportSrtClick(Sender: TObject); procedure tbDeleteSrtClick(Sender: TObject); procedure tbExportSrtClick(Sender: TObject); procedure PreviewComXMLContentDisplay(var contentFontRec: TFontRec; dataType: Integer; isReading: Boolean; DrawType: Integer; isPrinting: Boolean); procedure xlbSetupClick(Sender: TObject); procedure PreviewComXMLCrossTabLabelShow(valIDX: Integer; var ExLeft, ExRight: Double; var isShow: Boolean; CrsTabShowType: Integer); procedure rdbtnA4Click(Sender: TObject); procedure chkFillZeroClick(Sender: TObject); procedure PreviewComXMLGetDatasetEvent(DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet); private FProjectData: TProjectData; FCurPage: Integer; FiPageGroup: Integer; FiCenterPerPage: Integer; FbNormal : Boolean; FDisplayCount: Integer; FLockForm: Boolean; // 报表数据准备 FReportDataPrepare: TReportPrepare; procedure InitPageSettings; procedure InitFont; procedure InitPaperSettings(ATemplate: TTemplateNode); function GetHintStr: string; function AddClassNode(AParent: TExTreeNode; const AName: string): TExTreeNode; function GetClassNode(ANode: TTemplateNode): TExTreeNode; function GetSubClassNode(AClassNode: TExTreeNode; ANode: TTemplateNode): TExTreeNode; procedure AddReportTemplate(ANode: TTemplateNode); procedure LoadReportTemplets; procedure SaveAuditOpinion(ATemplate: TTemplateNode); procedure SaveReportInteractData(ATemplate: TTemplateNode); procedure ResizePreviewBox; procedure PreviewReportCurPage; procedure RepaintCurPagePreview; procedure LoadTemplet(ATemplate: TTemplateNode); procedure LoadTempletAndDisplay; procedure BeforeExport; procedure AfterExport; procedure LoadExcelBorder(var Border : TColumnLineRec); procedure PrintReport(ATemplateNode: TTemplateNode; isPDF, isExcel: boolean; ExcelOutputName, TemplateFileName: string); procedure ExportXlsReport(AStartPage, AEndPage: Integer; const AFileName: string); procedure ExportCurXlsReport; procedure ExportAllSelectedXlsReports; procedure PrintAllSelectedReports; procedure ExportAllSelectedPDFReports; procedure SetProjectData(const Value: TProjectData); procedure SetCurPage(const Value: Integer); function GetPrintEndPage: Integer; function GetPrintStartPage: Integer; function GetPageCount: Integer; function GetPrecededCount: Integer; function GetExcelMode: TOutputExcelMode; function GetIsExcel2010: Boolean; public destructor Destroy; override; procedure InitFormView; procedure InitReportSettings(ATemplate: TTemplateNode = nil); property ProjectData: TProjectData read FProjectData write SetProjectData; // 当前预览的页码 property CurPage: Integer read FCurPage write SetCurPage; // 显示几页 property DisplayCount: Integer read FDisplayCount write FDisplayCount; // 翻到的页数(例如:当前显示9页,显示4页,则翻到的页数为3) property PrecededCount: Integer read GetPrecededCount; property PrintStartPage: Integer read GetPrintStartPage; property PrintEndPage: Integer read GetPrintEndPage; property PageCount: Integer read GetPageCount; property ExcelMode: TOutputExcelMode read GetExcelMode; property IsExcel2010: Boolean read GetIsExcel2010; property LockForm: Boolean read FLockForm write FLockForm; end; procedure DisplayReportsForm(AProjectData: TProjectData); implementation uses UtilMethods, Math, DirectPrintUnit, Globals, ZhAPI, ReportAdjustFrm, Contnrs, mEncryptUnit, Printers, WinSpool, MainFrm, ConstUnit, GclBillsGatherModel; {$R *.dfm} procedure DisplayReportsForm(AProjectData: TProjectData); var ReportsForm: TReportsForm; begin ReportsForm := TReportsForm.Create(nil); {ReportsForm.BorderIcons := ReportsForm.BorderIcons - [biMaximize]; ReportsForm.WindowState := wsMaximized;} ReportsForm.ProjectData := AProjectData; ReportsForm.InitReportSettings; ReportsForm.InitFormView; try ReportsForm.ShowModal; finally ReportsForm.Free; AProjectData.ClearReportCacheData; end; end; { TReportsForm } procedure TReportsForm.LoadReportTemplets; var iTemplate: Integer; TemplateNode: TTemplateNode; ClassNode: TExTreeNode; begin extvReport.Items.Clear; for iTemplate := 0 to ReportTemplateManager.Count - 1 do begin TemplateNode := ReportTemplateManager.Template[iTemplate]; AddReportTemplate(TemplateNode); end; extvReport.AlphaSort; // 强制展开全部节点 // 某些情况下,创建节点处的展开方法失效 ClassNode := extvReport.Items.GetFirstNode; while Assigned(ClassNode) do begin ClassNode.ForcedExpand(True); ClassNode := ClassNode.getNextSibling; end; extvReport.Selected := extvReport.Items.GetFirstNode; end; procedure TReportsForm.LoadTempletAndDisplay; procedure ResetReportsVariant; var iPage: Integer; begin FbNormal := False; xcbPages.Items.Clear; for iPage := 1 to PreviewComXML.TotalPages do xcbPages.Items.Add(IntToStr(iPage)); xcbStartPage.Items.Assign(xcbPages.Items); xcbStartPage.ItemIndex := 0; xcbEndPage.Items.Assign(xcbPages.Items); xcbEndPage.ItemIndex := xcbEndPage.Items.Count - 1; xlbRealSize.Down := True; DisplayCount := 1; CurPage := 1; end; procedure WaringAndEmptyPreview(AStr: string); var OldBrushColor, OldPenColor: TColor; begin TipMessage(AStr, Handle); OldBrushColor := PreviewBox.Canvas.Brush.Color; OldPenColor := PreviewBox.Canvas.Pen.Color; try PreviewBox.Canvas.Brush.Color := clBtnFace; PreviewBox.Canvas.Pen.Color := clBlack; PreviewBox.Canvas.Rectangle(PreviewBox.BoundsRect); finally PreviewBox.Canvas.Brush.Color := OldBrushColor; PreviewBox.Canvas.Pen.Color := OldPenColor; end; end; procedure PreviewTemplet; begin try ResizePreviewBox; ResetReportsVariant; except WaringAndEmptyPreview('当前报表显示可能存在问题,请与纵横客服中心联系:(0756)3850888。'); end; end; procedure LoadEmptyTempletAndDisplay; begin WaringAndEmptyPreview('报表无数据,请选择其他报表。'); end; var vTemplateNode: TTemplateNode; pNode: PTemplateNode; begin if not Assigned(extvReport.Selected) then Exit; vTemplateNode := TTemplateNode(extvReport.Selected.Data); if not Assigned(vTemplateNode) then Exit; ReportTemplateManager.Current := vTemplateNode; // 交互表 if vTemplateNode.InteractFlag <> 0 then SaveReportInteractData(vTemplateNode); // 准备额外数据 if vTemplateNode.DataPrepareFlag <> 0 then FReportDataPrepare.PrepareData(vTemplateNode.DataPrepareFlag); Screen.Cursor := crHourGlass; try LoadTemplet(vTemplateNode); if PreviewComXML.TotalPages > 0 then PreviewTemplet else LoadEmptyTempletAndDisplay; finally Screen.Cursor := crDefault; end; end; procedure TReportsForm.SetProjectData(const Value: TProjectData); begin FProjectData := Value; FReportDataPrepare := TReportPrepare.Create(FProjectData); extvReport.Selected := extvReport.Items[0]; LoadReportTemplets; LoadTempletAndDisplay; end; procedure TReportsForm.PreviewComXMLGetDataConnection( var ADOCon: TADOConnection); begin ADOCon := FProjectData.ADOConnection; end; procedure TReportsForm.PreviewReportCurPage; begin if FbNormal then PreviewComXML.PrintPreviewCanvas(-1, PrecededCount, PreviewBox.Canvas) else //强制1:1显示 PreviewComXML.PrintPreviewCanvas(CurPage, 0, PreviewBox.Canvas); end; procedure TReportsForm.ResizePreviewBox; var iHeight, iWidth: Integer; begin if FbNormal then begin iHeight := sbReportsPreview.ClientHeight; iWidth := sbReportsPreview.ClientWidth; end else begin iHeight := Max(PreviewComXML.PrintHeight + 20, sbReportsPreview.ClientHeight); iWidth := Max(PreviewComXML.PrintWidth + 20, sbReportsPreview.ClientWidth); end; if PreviewBox.Height <> iHeight then begin PreviewBox.Height := iHeight; PreviewBox.Picture.Bitmap.Height := iHeight; end; if PreviewBox.Width <> iWidth then begin PreviewBox.Width := iWidth; PreviewBox.Picture.Bitmap.Width := iWidth; end; end; procedure TReportsForm.RepaintCurPagePreview; begin ResizePreviewBox; PreviewReportCurPage; end; procedure TReportsForm.xlbRealSizeClick(Sender: TObject); begin FbNormal := False; DisplayCount := TdxBarLargeButton(Sender).Tag; RepaintCurPagePreview; end; procedure TReportsForm.xlbOnePageClick(Sender: TObject); begin PreviewComXML.PreviewRows := 1; PreviewComXML.PreviewCols := 1; DisplayCount := TdxBarLargeButton(Sender).Tag; FbNormal := True; RepaintCurPagePreview; end; procedure TReportsForm.xlbTwoPageClick(Sender: TObject); begin if PreviewComXML.ReportSize.X > PreviewComXML.ReportSize.Y then begin PreviewComXML.PreviewRows := 2; PreviewComXML.PreviewCols := 1; end else begin PreviewComXML.PreviewRows := 1; PreviewComXML.PreviewCols := 2; end; DisplayCount := TdxBarLargeButton(Sender).Tag; FbNormal := true; RepaintCurPagePreview; end; procedure TReportsForm.xlbFourPageClick(Sender: TObject); begin PreviewComXML.PreviewRows := 2; PreviewComXML.PreviewCols := 2; DisplayCount := TdxBarLargeButton(Sender).Tag; FbNormal := true; RepaintCurPagePreview; end; procedure TReportsForm.xlbFirstPageClick(Sender: TObject); begin CurPage := 1; end; procedure TReportsForm.SetCurPage(const Value: Integer); begin if (Value < 0) or (Value > PageCount) then Exit; FCurPage := Value; xcbPages.Text := IntToStr(FCurPage); //PreviewComXML.FillZero := chkFillZero.Checked; PreviewReportCurPage; end; function TReportsForm.GetPrintEndPage: Integer; begin Result := StrToIntDef(xcbEndPage.Text, 0); end; function TReportsForm.GetPrintStartPage: Integer; begin Result := StrToIntDef(xcbStartPage.Text, 0); end; function TReportsForm.GetPageCount: Integer; begin Result := PreviewComXML.TotalPages; end; function TReportsForm.GetPrecededCount: Integer; begin Result := (CurPage + (DisplayCount - 1)) div DisplayCount; end; procedure TReportsForm.xlbPrePageClick(Sender: TObject); begin if CurPage > 1 then CurPage := CurPage - 1; end; procedure TReportsForm.xlbNextPageClick(Sender: TObject); begin if CurPage < PageCount then CurPage := CurPage + 1; end; procedure TReportsForm.xlbLastPageClick(Sender: TObject); begin CurPage := PageCount; end; procedure TReportsForm.xcbPagesChange(Sender: TObject); begin if (StrToIntDef(xcbPages.Text, 0) > 0) and (StrToIntDef(xcbPages.Text, 0) <= PageCount) then CurPage := StrToIntDef(xcbPages.Text, 0) else xcbPages.Text := IntToStr(CurPage); end; procedure TReportsForm.xlbPrintCurPageClick(Sender: TObject); begin if _IsEncrypt or G_IsCloud then PreviewComXML.Print(CurPage, 1) else TipMessage(GetHintStr, Handle); end; procedure TReportsForm.xcbStartPageChange(Sender: TObject); begin if (StrToIntDef(TdxBarCombo(Sender).Text, 0) > 0) and (StrToIntDef(TdxBarCombo(Sender).Text, 0) <= PageCount) then TdxBarCombo(Sender).Tag := StrToIntDef(TdxBarCombo(Sender).Text, 0) else TdxBarCombo(Sender).Text := IntToStr(TdxBarCombo(Sender).Tag); end; procedure TReportsForm.xlbPrintClick(Sender: TObject); begin if _IsEncrypt or G_IsCloud then begin if extvReport.LeafCheckedCount > 0 then PrintAllSelectedReports else PreviewComXML.PrintMultiPages(PrintStartPage, PrintEndPage); end else TipMessage(GetHintStr, Handle); end; procedure TReportsForm.PrintAllSelectedReports; var iIndex: Integer; Node: TExTreeNode; vTemplateNode: TTemplateNode; begin for iIndex := 0 to extvReport.Items.Count - 1 do begin Node := extvReport.Items[iIndex]; if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue; vTemplateNode := TTemplateNode(Node.Data); if FileExists(vTemplateNode.FileName) then directPrintReport(PreviewBox.Canvas, vTemplateNode.FileName, PreviewComXML, False, False, oemNormal,'','', IsExcel2010); end; extvReport.ClearChecked; end; procedure TReportsForm.xlbToPDFClick(Sender: TObject); begin if _IsEncrypt or G_IsCloud then begin if extvReport.LeafCheckedCount > 0 then ExportAllSelectedPDFReports else PreviewComXML.PrintPDF(PrintStartPage, PrintEndPage); end else TipMessage(GetHintStr, Handle); end; procedure TReportsForm.ExportAllSelectedPDFReports; var iIndex: Integer; Node: TExTreeNode; vTemplateNode: TTemplateNode; begin for iIndex := 0 to extvReport.Items.Count - 1 do begin Node := extvReport.Items[iIndex]; if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue; vTemplateNode := TTemplateNode(Node.Data); if FileExists(vTemplateNode.FileName) then PrintReport(vTemplateNode, True, False,'',''); end; extvReport.ClearChecked; end; procedure TReportsForm.xlbToExcelClick(Sender: TObject); begin if _IsEncrypt or G_IsCloud then begin if extvReport.LeafCheckedCount > 0 then ExportAllSelectedXlsReports else ExportCurXlsReport; end else TipMessage(GetHintStr, Handle); end; procedure TReportsForm.ExportAllSelectedXlsReports; var iIndex: Integer; Node: TExTreeNode; vTemplateNode: TTemplateNode; sPath, sOutputFileName: String; begin if BrowseFolder(sPath, '请选择导出报表路径', Handle) then begin for iIndex := 0 to extvReport.Items.Count - 1 do begin Node := extvReport.Items[iIndex]; if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue; vTemplateNode := TTemplateNode(Node.Data); sOutputFileName := sPath + ExtractSimpleFileName(vTemplateNode.FileName) + '.xls'; if FileExists(vTemplateNode.FileName) then PrintReport(vTemplateNode, False, True, sOutputFileName, GetTemplateXlsFileName); end; extvReport.ClearChecked; end; end; procedure TReportsForm.ExportCurXlsReport; var sFileName: string; begin sFileName := extvReport.Selected.Text; if (PrintStartPage <= PrintEndPage) and SaveFile(sFileName, '.xls') then ExportXlsReport(PrintStartPage, PrintEndPage, sFileName); end; procedure TReportsForm.AfterExport; begin // ToDo - 关闭进度条 // ToDo - 取消设置Update进度条事件 // PreviewComXML.OnProgress := nil; Screen.Cursor := crDefault; end; procedure TReportsForm.BeforeExport; begin Screen.Cursor := crHourGlass; // ToDo - 设置Update进度条事件 // PreviewComXML.OnProgress := PreviewComXMLProgress; // ToDo - 打开进度条 end; function TReportsForm.GetExcelMode: TOutputExcelMode; begin if chkExcelMode.Checked then Result := oemOneSheet else Result := oemNormal; end; procedure TReportsForm.extvReportClick(Sender: TObject); begin LoadTempletAndDisplay; end; procedure TReportsForm.xlbCloseClick(Sender: TObject); begin Close; end; procedure TReportsForm.AddReportTemplate(ANode: TTemplateNode); var vClassNode, vNode: TExTreeNode; begin vClassNode := GetClassNode(ANode); if ANode.SubClassNum <> '' then vClassNode := GetSubClassNode(vClassNode, ANode); vNode := extvReport.Items.AddChildObject(vClassNode, ANode.TemplateName, Pointer(ANode)); vNode.ImageIndex := 2; vNode.SelectedIndex := 3; vNode.Checked := csUnchecked; if (vClassNode <> nil) and not vClassNode.Expanded then vClassNode.Expanded := True; end; function TReportsForm.GetClassNode(ANode: TTemplateNode): TExTreeNode; function FindClassNode(const AName: string): TExTreeNode; var I: Integer; vNode: TExTreeNode; begin Result := nil; for I := 0 to extvReport.Items.Count - 1 do begin vNode := extvReport.Items.Item[I]; if SameText(vNode.Text, AName) then begin Result := vNode; Break; end; end; end; begin Result := FindClassNode(ANode.ClassNum + '.' + ANode.ClassName); if not Assigned(Result) then Result := AddClassNode(nil, ANode.ClassNum + '.' + ANode.ClassName); end; procedure TReportsForm.tbImportSrtClick(Sender: TObject); var sFileName, sNewFileName: string; vTemplateNode: TTemplateNode; begin if SelectFile(sFileName, '.srt') then begin sNewFileName := GetReportTemplatePath + ExtractFileName(sFileName); if not FileExists(sNewFileName) then begin CopyFile(PChar(sFileName), PChar(sNewFileName), True); vTemplateNode := ReportTemplateManager.AddReportTemplate(sNewFileName); AddReportTemplate(vTemplateNode); end else if QuestMessage('已存在报表模板' + ExtractFileName(sFileName) + ',是否覆盖原模板?', Handle) then CopyFile(PChar(sFileName), PChar(sNewFileName), False) else Exit; end; end; procedure TReportsForm.tbDeleteSrtClick(Sender: TObject); var vTemplateNode: TTemplateNode; begin if not Assigned(extvReport.Selected) then Exit; vTemplateNode := TTemplateNode(extvReport.Selected.Data); if not Assigned(vTemplateNode) then Exit; extvReport.Items.Delete(extvReport.Selected); DeleteFile(vTemplateNode.FileName); ReportTemplateManager.DeleteReportTemplate(vTemplateNode); LoadTempletAndDisplay; end; procedure TReportsForm.tbExportSrtClick(Sender: TObject); var vTemplateNode: TTemplateNode; sFileName: string; begin if not Assigned(extvReport.Selected) then Exit; vTemplateNode := TTemplateNode(extvReport.Selected.Data); if not Assigned(vTemplateNode) then Exit; sFileName := vTemplateNode.TemplateName; if SaveFile(sFileName, '.srt') then begin if not FileExists(sFileName) or QuestMessage('存在同名文件,是否覆盖?', Handle) then CopyFile(PChar(vTemplateNode.FileName), PChar(sFileName), False); end; end; procedure TReportsForm.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 TReportsForm.xlbSetupClick(Sender: TObject); begin if AdjustReport then LoadTempletAndDisplay; end; procedure TReportsForm.InitReportSettings(ATemplate: TTemplateNode); begin PreviewComXML.FillZero := chkFillZero.Checked; InitPageSettings; InitPaperSettings(ATemplate); end; procedure TReportsForm.InitPageSettings; begin // 设置页面大小 PreviewComXML.setPageSize(ReportConfig.PageSize); // 设置边距 PreviewComXML.setEdge(0, '', ReportConfig.LeftEdge/10); PreviewComXML.setEdge(1, '', ReportConfig.RightEdge/10); PreviewComXML.setEdge(2, '', ReportConfig.UpEdge/10); PreviewComXML.setEdge(3, '', ReportConfig.DownEdge/10); end; procedure TReportsForm.InitPaperSettings(ATemplate: TTemplateNode); procedure InitRepBorderLine; var i: Integer; ObjList : TList; ShapeRec : PPicRec; begin ObjList := TList.Create; try PreviewComXML.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; PreviewComXML.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 PreviewComXML.getAllFlowShowContentObjs(ObjList); // 设置报表表格横线 for i := 0 to ObjList.Count - 1 do begin FlowContentRec := ObjList[i]; FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth; FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth; PreviewComXML.setFlowContentObj(FlowContentRec); end; PreviewComXML.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; PreviewComXML.setCrossContentObj(CrossContentRec); end; // 设置报表表格竖线 PreviewComXML.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; PreviewComXML.setFlowContentObj(FlowContentRec); end; PreviewComXML.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; PreviewComXML.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; PreviewComXML.setActShowElementObj(PSR); end; end; finally ObjList.Free; end; end; begin if not Assigned(ATemplate) or (ATemplate.SelfFormat = 0) then begin InitFont; // 各类字体 InitRepBorderLine; // 报表边框 InitRepCellLine; // 报表表格 InitOtherArea; // 活动区域 end; end; procedure TReportsForm.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 TReportsForm.rdbtnA4Click(Sender: TObject); begin ReportConfig.PageSize := TRadioButton(Sender).Caption; SetPrinterPageSize(ReportConfig.PageSize); LoadTempletAndDisplay; end; procedure TReportsForm.chkFillZeroClick(Sender: TObject); begin PreviewComXML.FillZero := chkFillZero.Checked; PreviewReportCurPage; end; procedure TReportsForm.InitFont; 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); PreviewComXML.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 PreviewComXML.getAllColumnHeadObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin ColumnRec := ObjList[i]; AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont); InitColumnThick(ColumnRec); PreviewComXML.setColumnHeadTailObj(0, ColumnRec); end; PreviewComXML.getAllColumnTailObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin ColumnRec := ObjList[i]; AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont); InitColumnThick(ColumnRec); PreviewComXML.setColumnHeadTailObj(1,ColumnRec); end; PreviewComXML.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); PreviewComXML.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 // 设置表正文 PreviewComXML.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); PreviewComXML.setFlowContentObj(FlowContentRec); end; end; PreviewComXML.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); PreviewComXML.setBillContentObj(FlowContentRec); end; end; PreviewComXML.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); PreviewComXML.setCrossContentObj(CrossContentRec); end; end; // 设置表合计 for i := 0 to 2 do begin PreviewComXML.getAllSumObjs(i,ObjList); for j := 0 to ObjList.Count - 1 do begin SumRec := ObjList[j]; AssignFontRec(SumRec.FontRec, ReportConfig.GatherFont); PreviewComXML.setSumObj(SumRec); end; end; finally ObjList.Free; end; end; procedure InitGridHeaderFont; var i: Integer; ObjList: TList; HeadTailRec : PHeadRec; begin ObjList := TList.Create; try PreviewComXML.getAllHeadObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin HeadTailRec := ObjList[i]; AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont); PreviewComXML.setHeadTailObj(0, HeadTailRec); end; PreviewComXML.getAllTailObjs(ObjList); for i := 0 to ObjList.Count - 1 do begin HeadTailRec := ObjList[i]; AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont); PreviewComXML.setHeadTailObj(1, HeadTailRec); end; finally ObjList.Free; end; end; begin InitTitleFont; InitColumnFont; InitContentAndGatherFont; InitGridHeaderFont; end; procedure TReportsForm.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; function TReportsForm.GetIsExcel2010: Boolean; begin Result := chkExcel2010.Checked; end; procedure TReportsForm.InitFormView; begin rdbtnA3.Checked := SameText(rdbtnA3.Caption, ReportConfig.PageSize); rdbtnA4.Checked := SameText(rdbtnA4.Caption, ReportConfig.PageSize); SetPrinterPageSize(ReportConfig.PageSize); end; procedure TReportsForm.LoadExcelBorder(var Border: TColumnLineRec); begin Border.LeftThick := 0.5; Border.TopThick := 0.5; Border.RightThick := 0.5; Border.BottomThick := 0.5; if not ReportConfig.RepBorderVerLine then begin Border.LeftThick := 0; Border.RightThick := 0; end; end; procedure TReportsForm.PrintReport(ATemplateNode: TTemplateNode; isPDF, isExcel: boolean; ExcelOutputName, TemplateFileName: string); function CheckPrinterReady: Boolean; var PrinterHD: THandle; NoJobs: Word; s: LongWord; Job_Info: Array[0..10] of Job_INFO_1; cbNeeded: Cardinal; cReturned: Cardinal; ret: LongBool; begin if OpenPrinter(PChar(Printer.Printers[Printer.PrinterIndex]), PrinterHD, 0) then begin s := SizeOf(Job_Info); cbNeeded := 0; cReturned := 0; NoJobs := 10; ret := ENumJobs(PrinterHD, 0, NoJobs, 1, @Job_Info, s, cbNeeded, cReturned); Result := not((cReturned > 0) and (Job_Info[0].TotalPages > 0)); end else Result := True; end; procedure PrintTemplet; begin if isPDF then begin PreviewComXML.PrintPDFAll; while not CheckPrinterReady do Sleep(1000); end else if not isExcel then PreviewComXML.PrintAll(1) else ExportXlsReport(1, PreviewComXML.TotalPages, ExcelOutputName); end; var strRptName : string; begin if not FileExists(ATemplateNode.FileName) then Exit; ClearReportOprList; ClearReportFuncList; Screen.Cursor := crHourGlass; try LoadTemplet(ATemplateNode); if PreviewComXML.TotalPages > 0 then PrintTemplet {else if strRptName <> '' then begin LoadTemplet(RptArchiverObj, strRptName); PrintEmptyTemplet; end;} finally Screen.Cursor := crDefault; end; end; procedure TReportsForm.ExportXlsReport(AStartPage, AEndPage: Integer; const AFileName: string); procedure ExportPagesXlsReport(AStartPage, AEndPage: Integer; const AFileName: string); var Border : TColumnLineRec; begin LoadExcelBorder(Border); if IsExcel2010 then // 康博士代码中写批量打印是,用Printer.Canvas,打印当前时,用PreviewBox.Canvas。不懂为什么 PreViewComXML.OutputToExcelRangeXMLEx(PreviewBox.Canvas, AStartPage, AEndPage, GetTemplateXlsFileName, AFileName, Border, ExcelMode) else PreViewComXML.OutputToExcelFile(PreviewBox.Canvas, AStartPage, AEndPage, GetTemplateXlsFileName, AFileName, ExcelMode, Border); end; var iStartPage, iEndPage, iCount: Integer; sFileName: string; begin BeforeExport; try if (ExcelMode = oemNormal) and (PrintEndPage - PrintStartPage > 30) then begin iStartPage := PrintStartPage; iEndPage := iStartPage + 19; iCount := 1; repeat begin sFileName := Format('%s[%d].xls', [ExtractSimpleFileName(AFileName), iCount]); ExportPagesXlsReport(iStartPage, iEndPage, sFileName); iStartPage := iStartPage + 20; iEndPage := Min(iEndPage + 20, PrintEndPage); Inc(iCount); end until iStartPage > iEndPage; end else ExportPagesXlsReport(PrintStartPage, PrintEndPage, AFileName); finally AfterExport; end; end; procedure TReportsForm.LoadTemplet(ATemplate: TTemplateNode); 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 PreviewComXML.ReadReportStream(Mem) then Exit; // 将报表设置中的数据覆盖掉原模板的数据 InitReportSettings(ATemplate); // 保存 PreviewComXML.SaveToStream(Mem); // 再次读取,使报表设置中的设置生效 PreviewComXML.ReadReportStream(Mem); // ReadReportStream之后会将PreviewComXML的FillZero值赋为True,故再赋值一次 PreviewComXML.FillZero := chkFillZero.Checked; PreviewComXML.ReadDBData; PreviewComXML.AnalyseData; finally if Mem <> nil then Mem.Free; RptArchiverObj.Free; end; end; function TReportsForm.GetHintStr: string; begin Result := #13#10 + '对不起,学习版不提供报表打印、导出功能。'#13#10 + #13#10 + '以下为收费服务项目,请在必要时联系纵横:'#13#10 + #13#10 + '企业QQ:800003850 客服热线:(0756)3850888'; end; function TReportsForm.GetSubClassNode(AClassNode: TExTreeNode; ANode: TTemplateNode): TExTreeNode; function FindNode(AParent: TExTreeNode; const AName: string): TExTreeNode; var I: Integer; vNode: TExTreeNode; begin Result := nil; if Assigned(AParent) then vNode := AParent.getFirstChild else vNode := extvReport.Items.GetFirstNode; while not Assigned(Result) and Assigned(vNode) do begin if SameText(vNode.Text, AName) then Result := vNode; vNode := vNode.getNextSibling; end; end; begin Result := FindNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName); if not Assigned(Result) then Result := AddClassNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName); end; function TReportsForm.AddClassNode(AParent: TExTreeNode; const AName: string): TExTreeNode; begin Result := extvReport.Items.AddChildObject(AParent, AName, Pointer(nil)); Result.ImageIndex := 0; Result.SelectedIndex := 1; Result.Checked := csUnchecked; Result.Expanded := True; end; procedure TReportsForm.SaveReportInteractData(ATemplate: TTemplateNode); begin case ATemplate.InteractFlag of 1: SaveAuditOpinion(ATemplate); end; end; procedure TReportsForm.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; destructor TReportsForm.Destroy; begin FReportDataPrepare.Free; inherited; end; end.