unit ReportsFrm; interface // 导出PDF须定义该编译指令 {$DEFINE cplPrint} // 导出Excel须定义该编译指令 {$DEFINE cplOutputToExcelRange} uses ProjectData, ScFileArchiver, ReportManager, ConditionalDefines, PrintComTypeDefUnit, ADODB, DB, ReportPrepare, ReportConnection, AuditSelectFrm, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, PrintCom, PrintComXML, ExtCtrls, ExTreeView, ImgList, dxBarExtItems, dxBar, ComCtrls, ToolWin, StdCtrls, Jpeg; 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; BatchPrintXml: TPrintComXML; 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; // 数据库管理 FReportCon: TReportConnection; // 报表数据准备 FReportDataPrepare: TReportPrepare; procedure InitPageSettings(APrintCom: TPrintComXML); procedure InitFont(APrintCom: TPrintComXML); procedure InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML); 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; APrintCom: TPrintComXML); 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; APrintCom: TPrintComXML); 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(APrintCom: TPrintComXML; 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, Globals, ZhAPI, ReportAdjustFrm, Contnrs, mEncryptUnit, Printers, WinSpool, MainFrm, ConstUnit, GclBillsGatherModel, ReportPdfHelper; {$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.PreviewComXML); 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); FReportCon.RefreshConnection(vTemplateNode); Screen.Cursor := crHourGlass; try LoadTemplet(vTemplateNode, PreviewComXML); 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); FReportCon := TReportConnection.Create(FProjectData); extvReport.Selected := extvReport.Items[0]; LoadReportTemplets; LoadTempletAndDisplay; end; procedure TReportsForm.PreviewComXMLGetDataConnection( var ADOCon: TADOConnection); begin ADOCon := FReportCon.Connection; end; procedure TReportsForm.PreviewReportCurPage; begin if FbNormal then PreviewComXML.PrintPreviewCanvas(-1, PrecededCount, PreviewBox.Canvas, True) else //强制1:1显示 PreviewComXML.PrintPreviewCanvas(CurPage, 0, PreviewBox.Canvas, True); 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); var img: TJPEGImage; begin if _IsEncrypt or G_IsCloud then PreviewComXML.Print(PreviewBox.Canvas, CurPage, 1) else TipMessage(GetHintStr, Handle); //PreviewBox.Picture.SaveToFile('E:\1.jpg'); 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(PreviewBox.Canvas, 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 PrintReport(vTemplateNode, False, False, '', ''); end; extvReport.ClearChecked; end; procedure TReportsForm.xlbToPDFClick(Sender: TObject); var sFileName: string; begin if _IsEncrypt or G_IsCloud then begin if extvReport.LeafCheckedCount > 0 then ExportAllSelectedPDFReports else begin sFileName := PreviewComXML.ReportName + '.pdf'; if SaveFile(sFileName, '.pdf') then PdfHelper.ExportPages(PreviewComXML, sFileName, PrintStartPage, PrintEndPage); end; 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, PreviewComXML); 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); procedure ImportReportTemplate(const AFileName: string); var sNewFileName: string; vTemplateNode: TTemplateNode; begin sNewFileName := GetReportTemplatePath + ExtractFileName(AFileName); if not FileExists(sNewFileName) then begin CopyFileOrFolder(AFileName, sNewFileName); vTemplateNode := ReportTemplateManager.AddReportTemplate(sNewFileName); AddReportTemplate(vTemplateNode); end else if QuestMessage('已存在报表模板' + ExtractFileName(AFileName) + ',是否覆盖原模板?', Handle) then begin CopyFileOrFolder(AFileName, sNewFileName); vTemplateNode := ReportTemplateManager.FindTemplate(sNewFileName); if Assigned(vTemplateNode) then vTemplateNode.RefreshTemplateProperties; end else Exit; end; var sgsFiles: TStrings; iFile: Integer; begin sgsFiles := TStringList.Create; try if SelectFiles(sgsFiles, '.srt') then begin for iFile := 0 to sgsFiles.Count - 1 do ImportReportTemplate(sgsFiles.Strings[iFile]); end; finally sgsFiles.Free; 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 CopyFileOrFolder(vTemplateNode.FileName, sFileName); 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(APrintCom: TPrintComXML; ATemplate: TTemplateNode); begin APrintCom.FillZero := chkFillZero.Checked; 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 TReportsForm.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 TReportsForm.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 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(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 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; var sFileName: string; begin if isPDF then begin sFileName := BatchPrintXml.ReportName + '.pdf'; if SaveFile(sFileName, '.pdf') then PdfHelper.ExportAllPages(BatchPrintXml, sFileName); (* BatchPrintXml.PrintPDFAll(PreviewBox.Canvas); while not CheckPrinterReady do Sleep(1000); *) end else if not isExcel then BatchPrintXml.PrintAll(PreviewBox.Canvas, 1) else ExportXlsReport(1, BatchPrintXml.TotalPages, ExcelOutputName, BatchPrintXml); end; var strRptName : string; begin if not FileExists(ATemplateNode.FileName) then Exit; ClearReportOprList; ClearReportFuncList; Screen.Cursor := crHourGlass; try LoadTemplet(ATemplateNode, BatchPrintXml); if BatchPrintXml.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; APrintCom: TPrintComXML); procedure ExportPagesXlsReport(AStartPage, AEndPage: Integer; const AFileName: string); var Border : TColumnLineRec; begin LoadExcelBorder(Border); if IsExcel2010 then // 康博士代码中写批量打印是,用Printer.Canvas,打印当前时,用PreviewBox.Canvas。不懂为什么 APrintCom.OutputToExcelRangeXMLEx(PreviewBox.Canvas, AStartPage, AEndPage, GetTemplateXlsFileName, AFileName, Border, ExcelMode) else APrintCom.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(AStartPage, AEndPage, AFileName); finally AfterExport; end; end; procedure TReportsForm.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,故再赋值一次 APrintCom.FillZero := chkFillZero.Checked; InitPageSettings(APrintCom); APrintCom.ReadDBData; APrintCom.AnalyseData(PreviewBox.Canvas); 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 FReportCon.Free; FReportDataPrepare.Free; inherited; end; end.