unit SignOnlineReportsFrm; interface uses ProjectData, ReportManager, ReportConnection, ReportPrepare, PrintComTypeDefUnit, ADODB, DB, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, sdIDTree, sdDB, ComCtrls, ExtCtrls, VirtualTrees, PrintCom, PrintComXML, MScrollBox, StdCtrls, Buttons, PNGButton; 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; 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); private FProjectData: TProjectData; // 数据库管理 FReportCon: TReportConnection; // 报表数据准备 FReportDataPrepare: TReportPrepare; FPreviewList: TList; FCurPage: Integer; procedure OnViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure OnViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ExportReports(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; {$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; 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 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; 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); if Assigned(vTemplate) then begin ReportTemplateManager.Current := vTemplate; LoadTemplateAndDisplay(vTemplate); end; 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.PrintWidth; msbReportsPreview.VertScrollBar.Range := PreviewComXML.PrintHeight; 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); // 统一纸张大小 APrintCom.PrintPageSizeIdx := DMPAPER_A4; { 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) 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.PrintHeight ; AImage.Picture.Bitmap.Height := PreviewComXML.PrintHeight; AImage.Width := PreviewComXML.PrintWidth; AImage.Picture.Bitmap.Width := PreviewComXML.PrintWidth; 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'); 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 img: TImage; begin img := TImage.Create(nil); try img.Height := PreviewComXML.PrintHeight; img.Width := PreviewComXML.PrintWidth; PreviewComXML.PrintPreviewCanvas(APage, 0, img.Canvas, False); img.Picture.SaveToFile(APageFileName); finally 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 sFileName: string; begin if SaveFile(sFileName, '.zip') then begin ExportReports(sFileName); 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; end.