12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499 |
- 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.
|