ReportsFrm.pas 46 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559
  1. unit ReportsFrm;
  2. interface
  3. // 导出PDF须定义该编译指令
  4. {$DEFINE cplPrint}
  5. // 导出Excel须定义该编译指令
  6. {$DEFINE cplOutputToExcelRange}
  7. uses
  8. ProjectData, ScFileArchiver, ReportManager, ConditionalDefines,
  9. PrintComTypeDefUnit, ADODB, DB, ReportPrepare, ReportConnection,
  10. AuditSelectFrm,
  11. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  12. Dialogs, PrintCom, PrintComXML, ExtCtrls, ExTreeView, ImgList,
  13. dxBarExtItems, dxBar, ComCtrls, ToolWin, StdCtrls, Jpeg;
  14. type
  15. TReportsForm = class(TForm)
  16. xmReports: TdxBarManager;
  17. xlbPrint: TdxBarLargeButton;
  18. xlbToExcel: TdxBarLargeButton;
  19. xlbToPDF: TdxBarLargeButton;
  20. xlbRealSize: TdxBarLargeButton;
  21. xlbOnePage: TdxBarLargeButton;
  22. xlbTwoPage: TdxBarLargeButton;
  23. xlbFourPage: TdxBarLargeButton;
  24. xcbPages: TdxBarCombo;
  25. xlbFirstPage: TdxBarLargeButton;
  26. xlbPrePage: TdxBarLargeButton;
  27. xlbNextPage: TdxBarLargeButton;
  28. xlbLastPage: TdxBarLargeButton;
  29. xcbStartPage: TdxBarCombo;
  30. xcbEndPage: TdxBarCombo;
  31. xlbSetup: TdxBarLargeButton;
  32. xlbClose: TdxBarLargeButton;
  33. xlbPrintCurPage: TdxBarLargeButton;
  34. dxcciSafePrint: TdxBarControlContainerItem;
  35. ilstLarge: TImageList;
  36. pnlReportsList: TPanel;
  37. extvReport: TExTreeView;
  38. sprReportPreview: TSplitter;
  39. sbReportsPreview: TScrollBox;
  40. PreviewBox: TImage;
  41. PreviewComXML: TPrintComXML;
  42. ilstTree: TImageList;
  43. pnlTopButton: TPanel;
  44. tobaTemplateManager: TToolBar;
  45. tbImportSrt: TToolButton;
  46. tbExportSrt: TToolButton;
  47. tbDeleteSrt: TToolButton;
  48. ilstTemplateContorl: TImageList;
  49. pnlPaperSize: TPanel;
  50. rdbtnA3: TRadioButton;
  51. rdbtnA4: TRadioButton;
  52. chkFillZero: TCheckBox;
  53. dxcciPageSize: TdxBarControlContainerItem;
  54. pnlExcelMode: TPanel;
  55. chkExcelMode: TCheckBox;
  56. chkExcel2010: TCheckBox;
  57. dxcciExcelMode: TdxBarControlContainerItem;
  58. pnlReports: TPanel;
  59. BatchPrintXml: TPrintComXML;
  60. procedure PreviewComXMLGetDataConnection(var ADOCon: TADOConnection);
  61. procedure xlbRealSizeClick(Sender: TObject);
  62. procedure xlbOnePageClick(Sender: TObject);
  63. procedure xlbTwoPageClick(Sender: TObject);
  64. procedure xlbFourPageClick(Sender: TObject);
  65. procedure xlbFirstPageClick(Sender: TObject);
  66. procedure xlbPrePageClick(Sender: TObject);
  67. procedure xlbNextPageClick(Sender: TObject);
  68. procedure xlbLastPageClick(Sender: TObject);
  69. procedure xcbPagesChange(Sender: TObject);
  70. procedure xlbPrintCurPageClick(Sender: TObject);
  71. procedure xcbStartPageChange(Sender: TObject);
  72. procedure xlbPrintClick(Sender: TObject);
  73. procedure xlbToPDFClick(Sender: TObject);
  74. procedure xlbToExcelClick(Sender: TObject);
  75. procedure extvReportClick(Sender: TObject);
  76. procedure xlbCloseClick(Sender: TObject);
  77. procedure tbImportSrtClick(Sender: TObject);
  78. procedure tbDeleteSrtClick(Sender: TObject);
  79. procedure tbExportSrtClick(Sender: TObject);
  80. procedure PreviewComXMLContentDisplay(var contentFontRec: TFontRec;
  81. dataType: Integer; isReading: Boolean; DrawType: Integer;
  82. isPrinting: Boolean);
  83. procedure xlbSetupClick(Sender: TObject);
  84. procedure PreviewComXMLCrossTabLabelShow(valIDX: Integer; var ExLeft,
  85. ExRight: Double; var isShow: Boolean; CrsTabShowType: Integer);
  86. procedure rdbtnA4Click(Sender: TObject);
  87. procedure chkFillZeroClick(Sender: TObject);
  88. procedure PreviewComXMLGetDatasetEvent(DatasetInfo: PDatasetInfoRec;
  89. var ADataset: TDataSet);
  90. private
  91. FProjectData: TProjectData;
  92. FCurPage: Integer;
  93. FiPageGroup: Integer;
  94. FiCenterPerPage: Integer;
  95. FbNormal : Boolean;
  96. FDisplayCount: Integer;
  97. FLockForm: Boolean;
  98. // 数据库管理
  99. FReportCon: TReportConnection;
  100. // 报表数据准备
  101. FReportDataPrepare: TReportPrepare;
  102. procedure InitPageSettings(APrintCom: TPrintComXML);
  103. procedure InitFont(APrintCom: TPrintComXML);
  104. procedure InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  105. function GetHintStr: string;
  106. function AddClassNode(AParent: TExTreeNode; const AName: string): TExTreeNode;
  107. function GetClassNode(ANode: TTemplateNode): TExTreeNode;
  108. function GetSubClassNode(AClassNode: TExTreeNode; ANode: TTemplateNode): TExTreeNode;
  109. procedure AddReportTemplate(ANode: TTemplateNode);
  110. procedure LoadReportTemplets;
  111. procedure SaveAuditOpinion(ATemplate: TTemplateNode);
  112. procedure SaveReportInteractData(ATemplate: TTemplateNode);
  113. procedure ResizePreviewBox;
  114. procedure PreviewReportCurPage;
  115. procedure RepaintCurPagePreview;
  116. procedure LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  117. procedure LoadTempletAndDisplay;
  118. procedure BeforeExport;
  119. procedure AfterExport;
  120. procedure LoadExcelBorder(var Border : TColumnLineRec);
  121. procedure PrintReport(ATemplateNode: TTemplateNode; isPDF, isExcel: boolean;
  122. ExcelOutputName, TemplateFileName: string);
  123. procedure ExportXlsReport(AStartPage, AEndPage: Integer; const AFileName: string; APrintCom: TPrintComXML);
  124. procedure ExportCurXlsReport;
  125. procedure ExportAllSelectedXlsReports;
  126. procedure PrintAllSelectedReports;
  127. procedure ExportAllSelectedPDFReports;
  128. procedure SetProjectData(const Value: TProjectData);
  129. procedure SetCurPage(const Value: Integer);
  130. function GetPrintEndPage: Integer;
  131. function GetPrintStartPage: Integer;
  132. function GetPageCount: Integer;
  133. function GetPrecededCount: Integer;
  134. function GetExcelMode: TOutputExcelMode;
  135. function GetIsExcel2010: Boolean;
  136. public
  137. destructor Destroy; override;
  138. procedure InitFormView;
  139. procedure InitReportSettings(APrintCom: TPrintComXML; ATemplate: TTemplateNode = nil);
  140. property ProjectData: TProjectData read FProjectData write SetProjectData;
  141. // 当前预览的页码
  142. property CurPage: Integer read FCurPage write SetCurPage;
  143. // 显示几页
  144. property DisplayCount: Integer read FDisplayCount write FDisplayCount;
  145. // 翻到的页数(例如:当前显示9页,显示4页,则翻到的页数为3)
  146. property PrecededCount: Integer read GetPrecededCount;
  147. property PrintStartPage: Integer read GetPrintStartPage;
  148. property PrintEndPage: Integer read GetPrintEndPage;
  149. property PageCount: Integer read GetPageCount;
  150. property ExcelMode: TOutputExcelMode read GetExcelMode;
  151. property IsExcel2010: Boolean read GetIsExcel2010;
  152. property LockForm: Boolean read FLockForm write FLockForm;
  153. end;
  154. procedure DisplayReportsForm(AProjectData: TProjectData);
  155. implementation
  156. uses
  157. UtilMethods, Math, Globals, ZhAPI, ReportAdjustFrm,
  158. Contnrs, mEncryptUnit, Printers, WinSpool, MainFrm, ConstUnit,
  159. GclBillsGatherModel, ReportPdfHelper;
  160. {$R *.dfm}
  161. procedure DisplayReportsForm(AProjectData: TProjectData);
  162. var
  163. ReportsForm: TReportsForm;
  164. begin
  165. ReportsForm := TReportsForm.Create(nil);
  166. {ReportsForm.BorderIcons := ReportsForm.BorderIcons - [biMaximize];
  167. ReportsForm.WindowState := wsMaximized;}
  168. ReportsForm.ProjectData := AProjectData;
  169. ReportsForm.InitReportSettings(ReportsForm.PreviewComXML);
  170. ReportsForm.InitFormView;
  171. try
  172. ReportsForm.ShowModal;
  173. finally
  174. ReportsForm.Free;
  175. AProjectData.ClearReportCacheData;
  176. end;
  177. end;
  178. { TReportsForm }
  179. procedure TReportsForm.LoadReportTemplets;
  180. var
  181. iTemplate: Integer;
  182. TemplateNode: TTemplateNode;
  183. ClassNode: TExTreeNode;
  184. begin
  185. extvReport.Items.Clear;
  186. for iTemplate := 0 to ReportTemplateManager.Count - 1 do
  187. begin
  188. TemplateNode := ReportTemplateManager.Template[iTemplate];
  189. AddReportTemplate(TemplateNode);
  190. end;
  191. extvReport.AlphaSort;
  192. // 强制展开全部节点
  193. // 某些情况下,创建节点处的展开方法失效
  194. ClassNode := extvReport.Items.GetFirstNode;
  195. while Assigned(ClassNode) do
  196. begin
  197. ClassNode.ForcedExpand(True);
  198. ClassNode := ClassNode.getNextSibling;
  199. end;
  200. extvReport.Selected := extvReport.Items.GetFirstNode;
  201. end;
  202. procedure TReportsForm.LoadTempletAndDisplay;
  203. procedure ResetReportsVariant;
  204. var
  205. iPage: Integer;
  206. begin
  207. FbNormal := False;
  208. xcbPages.Items.Clear;
  209. for iPage := 1 to PreviewComXML.TotalPages do
  210. xcbPages.Items.Add(IntToStr(iPage));
  211. xcbStartPage.Items.Assign(xcbPages.Items);
  212. xcbStartPage.ItemIndex := 0;
  213. xcbEndPage.Items.Assign(xcbPages.Items);
  214. xcbEndPage.ItemIndex := xcbEndPage.Items.Count - 1;
  215. xlbRealSize.Down := True;
  216. DisplayCount := 1;
  217. CurPage := 1;
  218. end;
  219. procedure WaringAndEmptyPreview(AStr: string);
  220. var
  221. OldBrushColor, OldPenColor: TColor;
  222. begin
  223. TipMessage(AStr, Handle);
  224. OldBrushColor := PreviewBox.Canvas.Brush.Color;
  225. OldPenColor := PreviewBox.Canvas.Pen.Color;
  226. try
  227. PreviewBox.Canvas.Brush.Color := clBtnFace;
  228. PreviewBox.Canvas.Pen.Color := clBlack;
  229. PreviewBox.Canvas.Rectangle(PreviewBox.BoundsRect);
  230. finally
  231. PreviewBox.Canvas.Brush.Color := OldBrushColor;
  232. PreviewBox.Canvas.Pen.Color := OldPenColor;
  233. end;
  234. end;
  235. procedure PreviewTemplet;
  236. begin
  237. try
  238. ResizePreviewBox;
  239. ResetReportsVariant;
  240. except
  241. WaringAndEmptyPreview('当前报表显示可能存在问题,请与纵横客服中心联系:(0756)3850888。');
  242. end;
  243. end;
  244. procedure LoadEmptyTempletAndDisplay;
  245. begin
  246. WaringAndEmptyPreview('报表无数据,请选择其他报表。');
  247. end;
  248. var
  249. vTemplateNode: TTemplateNode;
  250. pNode: PTemplateNode;
  251. begin
  252. if not Assigned(extvReport.Selected) then Exit;
  253. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  254. if not Assigned(vTemplateNode) then Exit;
  255. ReportTemplateManager.Current := vTemplateNode;
  256. // 交互表
  257. if vTemplateNode.InteractFlag <> 0 then
  258. SaveReportInteractData(vTemplateNode);
  259. // 准备额外数据
  260. if vTemplateNode.DataPrepareFlag <> 0 then
  261. FReportDataPrepare.PrepareData(vTemplateNode.DataPrepareFlag);
  262. FReportCon.RefreshConnection(vTemplateNode);
  263. Screen.Cursor := crHourGlass;
  264. try
  265. LoadTemplet(vTemplateNode, PreviewComXML);
  266. if PreviewComXML.TotalPages > 0 then
  267. PreviewTemplet
  268. else
  269. LoadEmptyTempletAndDisplay;
  270. finally
  271. Screen.Cursor := crDefault;
  272. end;
  273. end;
  274. procedure TReportsForm.SetProjectData(const Value: TProjectData);
  275. begin
  276. FProjectData := Value;
  277. FReportDataPrepare := TReportPrepare.Create(FProjectData);
  278. FReportCon := TReportConnection.Create(FProjectData);
  279. extvReport.Selected := extvReport.Items[0];
  280. LoadReportTemplets;
  281. LoadTempletAndDisplay;
  282. end;
  283. procedure TReportsForm.PreviewComXMLGetDataConnection(
  284. var ADOCon: TADOConnection);
  285. begin
  286. ADOCon := FReportCon.Connection;
  287. end;
  288. procedure TReportsForm.PreviewReportCurPage;
  289. begin
  290. if FbNormal then
  291. PreviewComXML.PrintPreviewCanvas(-1, PrecededCount, PreviewBox.Canvas, True)
  292. else //强制1:1显示
  293. PreviewComXML.PrintPreviewCanvas(CurPage, 0, PreviewBox.Canvas, True);
  294. end;
  295. procedure TReportsForm.ResizePreviewBox;
  296. var
  297. iHeight, iWidth: Integer;
  298. begin
  299. if FbNormal then
  300. begin
  301. iHeight := sbReportsPreview.ClientHeight;
  302. iWidth := sbReportsPreview.ClientWidth;
  303. end
  304. else
  305. begin
  306. iHeight := Max(PreviewComXML.PrintHeight + 20, sbReportsPreview.ClientHeight);
  307. iWidth := Max(PreviewComXML.PrintWidth + 20, sbReportsPreview.ClientWidth);
  308. end;
  309. if PreviewBox.Height <> iHeight then
  310. begin
  311. PreviewBox.Height := iHeight;
  312. PreviewBox.Picture.Bitmap.Height := iHeight;
  313. end;
  314. if PreviewBox.Width <> iWidth then
  315. begin
  316. PreviewBox.Width := iWidth;
  317. PreviewBox.Picture.Bitmap.Width := iWidth;
  318. end;
  319. end;
  320. procedure TReportsForm.RepaintCurPagePreview;
  321. begin
  322. ResizePreviewBox;
  323. PreviewReportCurPage;
  324. end;
  325. procedure TReportsForm.xlbRealSizeClick(Sender: TObject);
  326. begin
  327. FbNormal := False;
  328. DisplayCount := TdxBarLargeButton(Sender).Tag;
  329. RepaintCurPagePreview;
  330. end;
  331. procedure TReportsForm.xlbOnePageClick(Sender: TObject);
  332. begin
  333. PreviewComXML.PreviewRows := 1;
  334. PreviewComXML.PreviewCols := 1;
  335. DisplayCount := TdxBarLargeButton(Sender).Tag;
  336. FbNormal := True;
  337. RepaintCurPagePreview;
  338. end;
  339. procedure TReportsForm.xlbTwoPageClick(Sender: TObject);
  340. begin
  341. if PreviewComXML.ReportSize.X > PreviewComXML.ReportSize.Y then
  342. begin
  343. PreviewComXML.PreviewRows := 2;
  344. PreviewComXML.PreviewCols := 1;
  345. end
  346. else
  347. begin
  348. PreviewComXML.PreviewRows := 1;
  349. PreviewComXML.PreviewCols := 2;
  350. end;
  351. DisplayCount := TdxBarLargeButton(Sender).Tag;
  352. FbNormal := true;
  353. RepaintCurPagePreview;
  354. end;
  355. procedure TReportsForm.xlbFourPageClick(Sender: TObject);
  356. begin
  357. PreviewComXML.PreviewRows := 2;
  358. PreviewComXML.PreviewCols := 2;
  359. DisplayCount := TdxBarLargeButton(Sender).Tag;
  360. FbNormal := true;
  361. RepaintCurPagePreview;
  362. end;
  363. procedure TReportsForm.xlbFirstPageClick(Sender: TObject);
  364. begin
  365. CurPage := 1;
  366. end;
  367. procedure TReportsForm.SetCurPage(const Value: Integer);
  368. begin
  369. if (Value < 0) or (Value > PageCount) then Exit;
  370. FCurPage := Value;
  371. xcbPages.Text := IntToStr(FCurPage);
  372. //PreviewComXML.FillZero := chkFillZero.Checked;
  373. PreviewReportCurPage;
  374. end;
  375. function TReportsForm.GetPrintEndPage: Integer;
  376. begin
  377. Result := StrToIntDef(xcbEndPage.Text, 0);
  378. end;
  379. function TReportsForm.GetPrintStartPage: Integer;
  380. begin
  381. Result := StrToIntDef(xcbStartPage.Text, 0);
  382. end;
  383. function TReportsForm.GetPageCount: Integer;
  384. begin
  385. Result := PreviewComXML.TotalPages;
  386. end;
  387. function TReportsForm.GetPrecededCount: Integer;
  388. begin
  389. Result := (CurPage + (DisplayCount - 1)) div DisplayCount;
  390. end;
  391. procedure TReportsForm.xlbPrePageClick(Sender: TObject);
  392. begin
  393. if CurPage > 1 then
  394. CurPage := CurPage - 1;
  395. end;
  396. procedure TReportsForm.xlbNextPageClick(Sender: TObject);
  397. begin
  398. if CurPage < PageCount then
  399. CurPage := CurPage + 1;
  400. end;
  401. procedure TReportsForm.xlbLastPageClick(Sender: TObject);
  402. begin
  403. CurPage := PageCount;
  404. end;
  405. procedure TReportsForm.xcbPagesChange(Sender: TObject);
  406. begin
  407. if (StrToIntDef(xcbPages.Text, 0) > 0) and
  408. (StrToIntDef(xcbPages.Text, 0) <= PageCount) then
  409. CurPage := StrToIntDef(xcbPages.Text, 0)
  410. else
  411. xcbPages.Text := IntToStr(CurPage);
  412. end;
  413. procedure TReportsForm.xlbPrintCurPageClick(Sender: TObject);
  414. var
  415. img: TJPEGImage;
  416. begin
  417. if _IsEncrypt or G_IsCloud then
  418. PreviewComXML.Print(PreviewBox.Canvas, CurPage, 1)
  419. else
  420. TipMessage(GetHintStr, Handle);
  421. //PreviewBox.Picture.SaveToFile('E:\1.jpg');
  422. end;
  423. procedure TReportsForm.xcbStartPageChange(Sender: TObject);
  424. begin
  425. if (StrToIntDef(TdxBarCombo(Sender).Text, 0) > 0) and
  426. (StrToIntDef(TdxBarCombo(Sender).Text, 0) <= PageCount) then
  427. TdxBarCombo(Sender).Tag := StrToIntDef(TdxBarCombo(Sender).Text, 0)
  428. else
  429. TdxBarCombo(Sender).Text := IntToStr(TdxBarCombo(Sender).Tag);
  430. end;
  431. procedure TReportsForm.xlbPrintClick(Sender: TObject);
  432. begin
  433. if _IsEncrypt or G_IsCloud then
  434. begin
  435. if extvReport.LeafCheckedCount > 0 then
  436. PrintAllSelectedReports
  437. else
  438. PreviewComXML.PrintMultiPages(PreviewBox.Canvas, PrintStartPage, PrintEndPage);
  439. end
  440. else
  441. TipMessage(GetHintStr, Handle);
  442. end;
  443. procedure TReportsForm.PrintAllSelectedReports;
  444. var
  445. iIndex: Integer;
  446. Node: TExTreeNode;
  447. vTemplateNode: TTemplateNode;
  448. begin
  449. for iIndex := 0 to extvReport.Items.Count - 1 do
  450. begin
  451. Node := extvReport.Items[iIndex];
  452. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  453. vTemplateNode := TTemplateNode(Node.Data);
  454. if FileExists(vTemplateNode.FileName) then
  455. PrintReport(vTemplateNode, False, False, '', '');
  456. end;
  457. extvReport.ClearChecked;
  458. end;
  459. procedure TReportsForm.xlbToPDFClick(Sender: TObject);
  460. var
  461. sFileName: string;
  462. begin
  463. if _IsEncrypt or G_IsCloud then
  464. begin
  465. if extvReport.LeafCheckedCount > 0 then
  466. ExportAllSelectedPDFReports
  467. else
  468. begin
  469. sFileName := PreviewComXML.ReportName + '.pdf';
  470. if SaveFile(sFileName, '.pdf') then
  471. PdfHelper.ExportPages(PreviewComXML, sFileName, PrintStartPage, PrintEndPage);
  472. end;
  473. end
  474. else
  475. TipMessage(GetHintStr, Handle);
  476. end;
  477. procedure TReportsForm.ExportAllSelectedPDFReports;
  478. var
  479. iIndex: Integer;
  480. Node: TExTreeNode;
  481. vTemplateNode: TTemplateNode;
  482. begin
  483. for iIndex := 0 to extvReport.Items.Count - 1 do
  484. begin
  485. Node := extvReport.Items[iIndex];
  486. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  487. vTemplateNode := TTemplateNode(Node.Data);
  488. if FileExists(vTemplateNode.FileName) then
  489. PrintReport(vTemplateNode, True, False,'','');
  490. end;
  491. extvReport.ClearChecked;
  492. end;
  493. procedure TReportsForm.xlbToExcelClick(Sender: TObject);
  494. begin
  495. if _IsEncrypt or G_IsCloud then
  496. begin
  497. if extvReport.LeafCheckedCount > 0 then
  498. ExportAllSelectedXlsReports
  499. else
  500. ExportCurXlsReport;
  501. end
  502. else
  503. TipMessage(GetHintStr, Handle);
  504. end;
  505. procedure TReportsForm.ExportAllSelectedXlsReports;
  506. var
  507. iIndex: Integer;
  508. Node: TExTreeNode;
  509. vTemplateNode: TTemplateNode;
  510. sPath, sOutputFileName: String;
  511. begin
  512. if BrowseFolder(sPath, '请选择导出报表路径', Handle) then
  513. begin
  514. for iIndex := 0 to extvReport.Items.Count - 1 do
  515. begin
  516. Node := extvReport.Items[iIndex];
  517. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  518. vTemplateNode := TTemplateNode(Node.Data);
  519. sOutputFileName := sPath + ExtractSimpleFileName(vTemplateNode.FileName) + '.xls';
  520. if FileExists(vTemplateNode.FileName) then
  521. PrintReport(vTemplateNode, False, True, sOutputFileName, GetTemplateXlsFileName);
  522. end;
  523. extvReport.ClearChecked;
  524. end;
  525. end;
  526. procedure TReportsForm.ExportCurXlsReport;
  527. var
  528. sFileName: string;
  529. begin
  530. sFileName := extvReport.Selected.Text;
  531. if (PrintStartPage <= PrintEndPage) and SaveFile(sFileName, '.xls') then
  532. ExportXlsReport(PrintStartPage, PrintEndPage, sFileName, PreviewComXML);
  533. end;
  534. procedure TReportsForm.AfterExport;
  535. begin
  536. // ToDo - 关闭进度条
  537. // ToDo - 取消设置Update进度条事件
  538. // PreviewComXML.OnProgress := nil;
  539. Screen.Cursor := crDefault;
  540. end;
  541. procedure TReportsForm.BeforeExport;
  542. begin
  543. Screen.Cursor := crHourGlass;
  544. // ToDo - 设置Update进度条事件
  545. // PreviewComXML.OnProgress := PreviewComXMLProgress;
  546. // ToDo - 打开进度条
  547. end;
  548. function TReportsForm.GetExcelMode: TOutputExcelMode;
  549. begin
  550. if chkExcelMode.Checked then
  551. Result := oemOneSheet
  552. else
  553. Result := oemNormal;
  554. end;
  555. procedure TReportsForm.extvReportClick(Sender: TObject);
  556. begin
  557. LoadTempletAndDisplay;
  558. end;
  559. procedure TReportsForm.xlbCloseClick(Sender: TObject);
  560. begin
  561. Close;
  562. end;
  563. procedure TReportsForm.AddReportTemplate(ANode: TTemplateNode);
  564. var
  565. vClassNode, vNode: TExTreeNode;
  566. begin
  567. vClassNode := GetClassNode(ANode);
  568. if ANode.SubClassNum <> '' then
  569. vClassNode := GetSubClassNode(vClassNode, ANode);
  570. vNode := extvReport.Items.AddChildObject(vClassNode, ANode.TemplateName, Pointer(ANode));
  571. vNode.ImageIndex := 2;
  572. vNode.SelectedIndex := 3;
  573. vNode.Checked := csUnchecked;
  574. if (vClassNode <> nil) and not vClassNode.Expanded then
  575. vClassNode.Expanded := True;
  576. end;
  577. function TReportsForm.GetClassNode(ANode: TTemplateNode): TExTreeNode;
  578. function FindClassNode(const AName: string): TExTreeNode;
  579. var
  580. I: Integer;
  581. vNode: TExTreeNode;
  582. begin
  583. Result := nil;
  584. for I := 0 to extvReport.Items.Count - 1 do
  585. begin
  586. vNode := extvReport.Items.Item[I];
  587. if SameText(vNode.Text, AName) then
  588. begin
  589. Result := vNode;
  590. Break;
  591. end;
  592. end;
  593. end;
  594. begin
  595. Result := FindClassNode(ANode.ClassNum + '.' + ANode.ClassName);
  596. if not Assigned(Result) then
  597. Result := AddClassNode(nil, ANode.ClassNum + '.' + ANode.ClassName);
  598. end;
  599. procedure TReportsForm.tbImportSrtClick(Sender: TObject);
  600. procedure ImportReportTemplate(const AFileName: string);
  601. var
  602. sNewFileName: string;
  603. vTemplateNode: TTemplateNode;
  604. begin
  605. sNewFileName := GetReportTemplatePath + ExtractFileName(AFileName);
  606. if not FileExists(sNewFileName) then
  607. begin
  608. CopyFileOrFolder(AFileName, sNewFileName);
  609. vTemplateNode := ReportTemplateManager.AddReportTemplate(sNewFileName);
  610. AddReportTemplate(vTemplateNode);
  611. end
  612. else
  613. if QuestMessage('已存在报表模板' + ExtractFileName(AFileName) + ',是否覆盖原模板?', Handle) then
  614. begin
  615. CopyFileOrFolder(AFileName, sNewFileName);
  616. vTemplateNode := ReportTemplateManager.FindTemplate(sNewFileName);
  617. if Assigned(vTemplateNode) then
  618. vTemplateNode.RefreshTemplateProperties;
  619. end
  620. else
  621. Exit;
  622. end;
  623. var
  624. sgsFiles: TStrings;
  625. iFile: Integer;
  626. begin
  627. sgsFiles := TStringList.Create;
  628. try
  629. if SelectFiles(sgsFiles, '.srt') then
  630. begin
  631. for iFile := 0 to sgsFiles.Count - 1 do
  632. ImportReportTemplate(sgsFiles.Strings[iFile]);
  633. end;
  634. finally
  635. sgsFiles.Free;
  636. end;
  637. end;
  638. procedure TReportsForm.tbDeleteSrtClick(Sender: TObject);
  639. var
  640. vTemplateNode: TTemplateNode;
  641. begin
  642. if not Assigned(extvReport.Selected) then Exit;
  643. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  644. if not Assigned(vTemplateNode) then Exit;
  645. extvReport.Items.Delete(extvReport.Selected);
  646. DeleteFile(vTemplateNode.FileName);
  647. ReportTemplateManager.DeleteReportTemplate(vTemplateNode);
  648. LoadTempletAndDisplay;
  649. end;
  650. procedure TReportsForm.tbExportSrtClick(Sender: TObject);
  651. var
  652. vTemplateNode: TTemplateNode;
  653. sFileName: string;
  654. begin
  655. if not Assigned(extvReport.Selected) then Exit;
  656. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  657. if not Assigned(vTemplateNode) then Exit;
  658. sFileName := vTemplateNode.TemplateName;
  659. if SaveFile(sFileName, '.srt') then
  660. begin
  661. if not FileExists(sFileName) or QuestMessage('存在同名文件,是否覆盖?', Handle) then
  662. CopyFileOrFolder(vTemplateNode.FileName, sFileName);
  663. end;
  664. end;
  665. procedure TReportsForm.PreviewComXMLContentDisplay(
  666. var contentFontRec: TFontRec; dataType: Integer; isReading: Boolean;
  667. DrawType: Integer; isPrinting: Boolean);
  668. begin
  669. if ReportConfig.ContentIsNarrow then
  670. begin
  671. if (isReading) then
  672. begin
  673. begin
  674. contentFontRec.FontName := 'Arial Narrow';
  675. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  676. end;
  677. end else
  678. begin
  679. if (DrawType = 3) or (DrawType = 5) then
  680. begin
  681. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  682. end else if (isPrinting) then
  683. begin
  684. contentFontRec.FontName := 'Arial Narrow';
  685. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 7 div 6;
  686. end else
  687. begin
  688. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  689. end;
  690. end;
  691. end;
  692. end;
  693. procedure TReportsForm.xlbSetupClick(Sender: TObject);
  694. begin
  695. if AdjustReport then
  696. LoadTempletAndDisplay;
  697. end;
  698. procedure TReportsForm.InitReportSettings(APrintCom: TPrintComXML; ATemplate: TTemplateNode);
  699. begin
  700. APrintCom.FillZero := chkFillZero.Checked;
  701. InitPageSettings(APrintCom);
  702. InitPaperSettings(ATemplate, APrintCom);
  703. {APrintCom.ShowBackgroundMark := FProjectData.ProjProperties.ShowReportShading;
  704. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShading;}
  705. if FProjectData.ProjProperties.ReportShowState then
  706. begin
  707. if FProjectData.ProjProperties.ReportShowStateWithoutReply and
  708. ((FProjectData.ProjProperties.AuditStatus = -1) or (FProjectData.PhaseIndex < FProjectData.ProjProperties.PhaseCount)) then
  709. APrintCom.ShowBackgroundMark := False
  710. else
  711. APrintCom.ShowBackgroundMark := True;
  712. end
  713. else
  714. APrintCom.ShowBackgroundMark := False;
  715. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShowStateText;
  716. end;
  717. procedure TReportsForm.InitPageSettings(APrintCom: TPrintComXML);
  718. begin
  719. // 设置页面大小
  720. APrintCom.setPageSize(ReportConfig.PageSize);
  721. if ReportConfig.PageSize = 'A3' then
  722. APrintCom.PrintPageSizeIdx := DMPAPER_A3
  723. else if ReportConfig.PageSize = 'A4' then
  724. APrintCom.PrintPageSizeIdx := DMPAPER_A4;
  725. // 设置边距
  726. APrintCom.setEdge(0, '', ReportConfig.LeftEdge/10);
  727. APrintCom.setEdge(1, '', ReportConfig.RightEdge/10);
  728. APrintCom.setEdge(2, '', ReportConfig.UpEdge/10);
  729. APrintCom.setEdge(3, '', ReportConfig.DownEdge/10);
  730. end;
  731. procedure TReportsForm.InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  732. procedure InitRepBorderLine;
  733. var
  734. i: Integer;
  735. ObjList : TList;
  736. ShapeRec : PPicRec;
  737. begin
  738. ObjList := TList.Create;
  739. try
  740. APrintCom.getAllShapeObjs(1, ObjList);
  741. for i := 0 to ObjList.Count - 1 do
  742. begin
  743. ShapeRec := ObjList[i];
  744. // 设置报表边框线粗
  745. ShapeRec.PenWidth := ReportConfig.BorderLine;
  746. // 设置是否绘制报表边框横线
  747. if (ShapeRec.ExArea.ExLeft <> ShapeRec.ExArea.ExRight) then
  748. begin
  749. if not ReportConfig.RepBorderUnderLine then
  750. ShapeRec.PenStyle := integer(psClear)
  751. else
  752. ShapeRec.PenStyle := integer(psSolid);
  753. end;
  754. // 设置是否绘制报表边框竖线
  755. if (ShapeRec.ExArea.ExTop <> ShapeRec.ExArea.ExBottom) and
  756. ((ShapeRec.ExArea.ExLeft = 0) or (ShapeRec.ExArea.ExLeft = 100)) then
  757. begin //这里的判断条件是约定好的
  758. if not ReportConfig.RepBorderVerLine then
  759. ShapeRec.PenStyle := integer(psClear)
  760. else
  761. ShapeRec.PenStyle := integer(psSolid)
  762. end;
  763. APrintCom.setShapeObj(ShapeRec);
  764. end;
  765. finally
  766. ObjList.Free;
  767. end;
  768. end;
  769. procedure InitRepCellLine;
  770. var
  771. i: Integer;
  772. ObjList : TList;
  773. ColumnRec : PColumnRec;
  774. FlowContentRec : PContentRec;
  775. CrossContentRec : PCrossContentRec;
  776. begin
  777. ObjList := TList.Create;
  778. try
  779. APrintCom.getAllFlowShowContentObjs(ObjList);
  780. // 设置报表表格横线
  781. for i := 0 to ObjList.Count - 1 do
  782. begin
  783. FlowContentRec := ObjList[i];
  784. FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  785. FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  786. APrintCom.setFlowContentObj(FlowContentRec);
  787. end;
  788. APrintCom.getAllCrossContentObjs(ObjList);
  789. for i := 0 to ObjList.Count - 1 do
  790. begin
  791. CrossContentRec := ObjList[i];
  792. CrossContentRec.CrossContent.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  793. CrossContentRec.CrossContent.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  794. APrintCom.setCrossContentObj(CrossContentRec);
  795. end;
  796. // 设置报表表格竖线
  797. APrintCom.getAllFlowShowContentObjs(ObjList);
  798. for i := 0 to ObjList.Count - 1 do
  799. begin
  800. FlowContentRec := ObjList[i];
  801. FlowContentRec.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  802. FlowContentRec.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  803. // 如果设置无表格边框线,则两端的表格竖线线粗为0
  804. if (not ReportConfig.RepBorderVerLine) then
  805. if (i = 0) then
  806. FlowContentRec.LineInfo.LeftThick := 0
  807. else if (i = ObjList.Count - 1) then
  808. FlowContentRec.LineInfo.RightThick := 0;
  809. APrintCom.setFlowContentObj(FlowContentRec);
  810. end;
  811. APrintCom.getAllCrossContentObjs(ObjList);
  812. for i := 0 to ObjList.Count - 1 do
  813. begin
  814. CrossContentRec := ObjList[i];
  815. CrossContentRec.CrossContent.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  816. CrossContentRec.CrossContent.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  817. ColumnRec := CrossContentRec.CrossContent.Column;
  818. //这里还要判断如果没有边框竖线的情况下,表格竖线边缘的线粗也为0
  819. //前提是所属表栏最右位置位于边缘
  820. if (not ReportConfig.RepBorderVerLine) and (ColumnRec<>nil) and
  821. ((ColumnRec.ExArea.ExRight = 100.0) or (ColumnRec.ExArea.ExLeft = 0.0)) then
  822. begin
  823. case CrossContentRec.CrossType of
  824. 0 : //交叉行
  825. begin
  826. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  827. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  828. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  829. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  830. end;
  831. 1 : //交叉列
  832. begin
  833. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  834. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  835. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  836. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  837. //(*
  838. if (CrossContentRec.CrossContent.isSpecialBorder) then
  839. begin
  840. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  841. CrossContentRec.CrossContent.SpecialLineInfo.RightThick := 0;
  842. end;
  843. //*)
  844. end;
  845. 2 : //显示数据
  846. begin
  847. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  848. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  849. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  850. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  851. end;
  852. 3 : //固定LABEL
  853. begin
  854. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  855. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  856. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  857. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  858. end;
  859. 4 : //序号
  860. begin
  861. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  862. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  863. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  864. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  865. end;
  866. 5 : //横向统计
  867. begin
  868. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  869. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  870. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  871. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  872. end;
  873. end;
  874. end;
  875. APrintCom.setCrossContentObj(CrossContentRec);
  876. end;
  877. finally
  878. ObjList.Free;
  879. end;
  880. end;
  881. procedure InitOtherArea;
  882. procedure SetPTRBorder(PTR : PTextRec);
  883. procedure SetLeftRightBorder;
  884. begin
  885. if PTR.ExArea.ExLeft = 0.0 then
  886. begin
  887. if BorderWidth = 0.0 then
  888. PTR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth;
  889. end;
  890. if PTR.ExArea.ExRight = 100.0 then
  891. begin
  892. if BorderWidth = 0.0 then
  893. PTR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth
  894. end;
  895. end;
  896. procedure SetHorLine;
  897. begin
  898. if (PTR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  899. PTR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  900. if (PTR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  901. PTR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  902. end;
  903. begin
  904. SetLeftRightBorder;
  905. SetHorLine;
  906. end;
  907. procedure SetPCRBorder(PCR : PColumnRec);
  908. procedure SetLeftRightBorder;
  909. begin
  910. if PCR.ExArea.ExLeft = 0.0 then
  911. begin
  912. if BorderWidth = 0.0 then
  913. PCR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth
  914. end;
  915. if PCR.ExArea.ExRight = 100.0 then
  916. begin
  917. if BorderWidth = 0.0 then
  918. PCR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth;
  919. end;
  920. end;
  921. procedure SetVerLine;
  922. begin
  923. if PCR.ExArea.ExLeft = 0.0 then
  924. PCR.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  925. if PCR.ExArea.ExRight = 100.0 then
  926. PCR.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  927. end;
  928. procedure SetHorLine;
  929. begin
  930. if (PCR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  931. PCR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  932. if (PCR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  933. PCR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  934. end;
  935. begin
  936. SetLeftRightBorder;
  937. SetVerLine;
  938. SetHorLine;
  939. end;
  940. var i,k : integer;
  941. ObjList : TList;
  942. ActAreaRec : PActiveAreaRec;
  943. PSR : PShowElementRec;
  944. begin
  945. ObjList := TList.Create;
  946. try
  947. ActAreaRec := nil;
  948. PreviewComXML.getAllActAreaObjs(ObjList);
  949. for i := 0 to ObjList.Count - 1 do
  950. begin
  951. ActAreaRec := ObjList[i];
  952. if (ActAreaRec.ShowType < 0) or (ActAreaRec.ShowType > 2) then Continue;
  953. if not Assigned(ActAreaRec.ElementList) then Continue;
  954. for k := 0 to ActAreaRec.ElementList.Count - 1 do
  955. begin
  956. PSR := PShowElementRec(ActAreaRec.ElementList[k]);
  957. case PSR.ElementType of
  958. 0..2 : SetPTRBorder(PSR.Data); //文本,参数,字段,表栏
  959. 7 : SetPCRBorder(PSR.Data) //Column
  960. end;
  961. APrintCom.setActShowElementObj(PSR);
  962. end;
  963. end;
  964. finally
  965. ObjList.Free;
  966. end;
  967. end;
  968. begin
  969. if not Assigned(ATemplate) or (ATemplate.SelfFormat = 0) then
  970. begin
  971. InitFont(APrintCom); // 各类字体
  972. InitRepBorderLine; // 报表边框
  973. InitRepCellLine; // 报表表格
  974. InitOtherArea; // 活动区域
  975. end;
  976. end;
  977. procedure TReportsForm.PreviewComXMLCrossTabLabelShow(valIDX: Integer;
  978. var ExLeft, ExRight: Double; var isShow: Boolean;
  979. CrsTabShowType: Integer);
  980. var field : PFieldRec;
  981. begin
  982. if (CrsTabShowType = -1) then exit;
  983. field := PreviewComXML.getFieldByID(6);
  984. if (field <> nil) then
  985. begin
  986. if (field.DataLen > valIDX) and (valIDX >= 0) then
  987. begin
  988. if (field.Value[valIDX] = 1.5) then
  989. begin
  990. case CrsTabShowType of
  991. 1 : begin
  992. isShow := false;
  993. end;
  994. 2 : begin
  995. ExLeft := 0;
  996. ExRight := 100;
  997. end;
  998. 3 : begin
  999. //
  1000. end
  1001. else
  1002. begin
  1003. //
  1004. end;
  1005. end;
  1006. end;
  1007. end;
  1008. end;
  1009. end;
  1010. procedure TReportsForm.rdbtnA4Click(Sender: TObject);
  1011. begin
  1012. ReportConfig.PageSize := TRadioButton(Sender).Caption;
  1013. SetPrinterPageSize(ReportConfig.PageSize);
  1014. LoadTempletAndDisplay;
  1015. end;
  1016. procedure TReportsForm.chkFillZeroClick(Sender: TObject);
  1017. begin
  1018. PreviewComXML.FillZero := chkFillZero.Checked;
  1019. PreviewReportCurPage;
  1020. end;
  1021. procedure TReportsForm.InitFont(APrintCom: TPrintComXML);
  1022. procedure AssignFontRec(AFontRec: TFontRec; AFont: TFont);
  1023. begin
  1024. AFontRec.FontName := AFont.Name;
  1025. AFontRec.FontHeight := Round(AFont.Size*4/3) ;
  1026. AFontRec.FontBold := 400 + Integer(fsBold in AFont.Style)*200;
  1027. AFontRec.FontItalic := Integer(fsItalic in AFont.Style);
  1028. AFontRec.FontUnderLine := Integer(fsUnderLine in AFont.Style);
  1029. end;
  1030. procedure InitTitleFont;
  1031. var
  1032. TitleRec : PTitleRec;
  1033. begin
  1034. TitleRec := PreviewComXML.getTitleByID(1);
  1035. if TitleRec <> nil then
  1036. begin
  1037. AssignFontRec(TitleRec.FontRec, ReportConfig.TitleFont);
  1038. APrintCom.setTitleObj(TitleRec);
  1039. end;
  1040. end;
  1041. procedure InitColumnFont;
  1042. procedure InitColumnThick(AColumnRec: PColumnRec);
  1043. begin
  1044. if (ReportConfig.ReportCellLine > 0.2) then
  1045. begin
  1046. if (AColumnRec.LineInfo.LeftThick > 0.2) then
  1047. AColumnRec.LineInfo.LeftThick := ReportConfig.ReportCellLine;
  1048. if (AColumnRec.LineInfo.RightThick > 0.2) then
  1049. AColumnRec.LineInfo.RightThick := ReportConfig.ReportCellLine;
  1050. if (AColumnRec.LineInfo.TopThick > 0.2) then
  1051. AColumnRec.LineInfo.TopThick := ReportConfig.ReportCellLine;
  1052. if (AColumnRec.LineInfo.BottomThick > 0.2) then
  1053. AColumnRec.LineInfo.BottomThick := ReportConfig.ReportCellLine;
  1054. end;
  1055. end;
  1056. var
  1057. i, j: Integer;
  1058. ObjList: TList;
  1059. ColumnRec : PColumnRec;
  1060. AAR : PActiveAreaRec;
  1061. SER : PShowElementRec;
  1062. begin
  1063. ObjList := TList.Create;
  1064. try
  1065. APrintCom.getAllColumnHeadObjs(ObjList);
  1066. for i := 0 to ObjList.Count - 1 do
  1067. begin
  1068. ColumnRec := ObjList[i];
  1069. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1070. InitColumnThick(ColumnRec);
  1071. APrintCom.setColumnHeadTailObj(0, ColumnRec);
  1072. end;
  1073. APrintCom.getAllColumnTailObjs(ObjList);
  1074. for i := 0 to ObjList.Count - 1 do
  1075. begin
  1076. ColumnRec := ObjList[i];
  1077. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1078. InitColumnThick(ColumnRec);
  1079. APrintCom.setColumnHeadTailObj(1,ColumnRec);
  1080. end;
  1081. APrintCom.getAllActAreaObjs(ObjList);
  1082. for i := 0 to ObjList.Count - 1 do
  1083. begin
  1084. AAR := ObjList[i];
  1085. for j := 0 to AAR.ElementList.Count - 1 do
  1086. begin
  1087. SER := AAR.ElementList[j];
  1088. if (SER.ElementType = 7) then
  1089. begin
  1090. ColumnRec := SER.Data;
  1091. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1092. InitColumnThick(ColumnRec);
  1093. APrintCom.setActShowElementObj(SER);
  1094. end;
  1095. end;
  1096. end;
  1097. finally
  1098. ObjList.Free;
  1099. end;
  1100. end;
  1101. procedure InitContentAndGatherFont;
  1102. var
  1103. i, j: Integer;
  1104. ObjList: TList;
  1105. FlowContentRec : PContentRec;
  1106. CrossContentRec : PCrossContentRec;
  1107. SumRec : PSumRec;
  1108. begin
  1109. ObjList := TList.Create;
  1110. try
  1111. // 设置表正文
  1112. APrintCom.getAllFlowShowContentObjs(ObjList);
  1113. for i := 0 to ObjList.Count - 1 do
  1114. begin
  1115. FlowContentRec := ObjList[i];
  1116. if not (FlowContentRec.Fixed) then
  1117. begin
  1118. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1119. APrintCom.setFlowContentObj(FlowContentRec);
  1120. end;
  1121. end;
  1122. APrintCom.getAllBillShowContentObjs(ObjList);
  1123. for i := 0 to ObjList.Count - 1 do
  1124. begin
  1125. FlowContentRec := ObjList[i];
  1126. if not(FlowContentRec.Fixed) then
  1127. begin
  1128. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1129. APrintCom.setBillContentObj(FlowContentRec);
  1130. end;
  1131. end;
  1132. APrintCom.getAllCrossContentObjs(ObjList);
  1133. for i := 0 to ObjList.Count - 1 do
  1134. begin
  1135. CrossContentRec := ObjList[i];
  1136. if not(CrossContentRec.CrossContent.Fixed) then
  1137. begin
  1138. AssignFontRec(CrossContentRec.CrossContent.FontRec, ReportConfig.ContentFont);
  1139. APrintCom.setCrossContentObj(CrossContentRec);
  1140. end;
  1141. end;
  1142. // 设置表合计
  1143. for i := 0 to 2 do
  1144. begin
  1145. APrintCom.getAllSumObjs(i,ObjList);
  1146. for j := 0 to ObjList.Count - 1 do
  1147. begin
  1148. SumRec := ObjList[j];
  1149. AssignFontRec(SumRec.FontRec, ReportConfig.GatherFont);
  1150. APrintCom.setSumObj(SumRec);
  1151. end;
  1152. end;
  1153. finally
  1154. ObjList.Free;
  1155. end;
  1156. end;
  1157. procedure InitGridHeaderFont;
  1158. var
  1159. i: Integer;
  1160. ObjList: TList;
  1161. HeadTailRec : PHeadRec;
  1162. begin
  1163. ObjList := TList.Create;
  1164. try
  1165. APrintCom.getAllHeadObjs(ObjList);
  1166. for i := 0 to ObjList.Count - 1 do
  1167. begin
  1168. HeadTailRec := ObjList[i];
  1169. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1170. APrintCom.setHeadTailObj(0, HeadTailRec);
  1171. end;
  1172. APrintCom.getAllTailObjs(ObjList);
  1173. for i := 0 to ObjList.Count - 1 do
  1174. begin
  1175. HeadTailRec := ObjList[i];
  1176. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1177. APrintCom.setHeadTailObj(1, HeadTailRec);
  1178. end;
  1179. finally
  1180. ObjList.Free;
  1181. end;
  1182. end;
  1183. begin
  1184. InitTitleFont;
  1185. InitColumnFont;
  1186. InitContentAndGatherFont;
  1187. InitGridHeaderFont;
  1188. end;
  1189. procedure TReportsForm.PreviewComXMLGetDatasetEvent(
  1190. DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet);
  1191. begin
  1192. if DatasetInfo.ID = 0 then
  1193. ADataSet := MemoryReportManager.GetSqlResultDataSet(ReportTemplateManager.Current.InteractInfo.Sql, FProjectData)
  1194. else
  1195. ADataset := MemoryReportManager.GetMemoryDataSet(DatasetInfo.ID, FProjectData);
  1196. end;
  1197. function TReportsForm.GetIsExcel2010: Boolean;
  1198. begin
  1199. Result := chkExcel2010.Checked;
  1200. end;
  1201. procedure TReportsForm.InitFormView;
  1202. begin
  1203. rdbtnA3.Checked := SameText(rdbtnA3.Caption, ReportConfig.PageSize);
  1204. rdbtnA4.Checked := SameText(rdbtnA4.Caption, ReportConfig.PageSize);
  1205. SetPrinterPageSize(ReportConfig.PageSize);
  1206. end;
  1207. procedure TReportsForm.LoadExcelBorder(var Border: TColumnLineRec);
  1208. begin
  1209. Border.LeftThick := 0.5;
  1210. Border.TopThick := 0.5;
  1211. Border.RightThick := 0.5;
  1212. Border.BottomThick := 0.5;
  1213. if not ReportConfig.RepBorderVerLine then
  1214. begin
  1215. Border.LeftThick := 0;
  1216. Border.RightThick := 0;
  1217. end;
  1218. end;
  1219. procedure TReportsForm.PrintReport(ATemplateNode: TTemplateNode;
  1220. isPDF, isExcel: boolean; ExcelOutputName, TemplateFileName: string);
  1221. function CheckPrinterReady: Boolean;
  1222. var
  1223. PrinterHD: THandle;
  1224. NoJobs: Word;
  1225. s: LongWord;
  1226. Job_Info: Array[0..10] of Job_INFO_1;
  1227. cbNeeded: Cardinal;
  1228. cReturned: Cardinal;
  1229. ret: LongBool;
  1230. begin
  1231. if OpenPrinter(PChar(Printer.Printers[Printer.PrinterIndex]), PrinterHD, 0) then
  1232. begin
  1233. s := SizeOf(Job_Info);
  1234. cbNeeded := 0;
  1235. cReturned := 0;
  1236. NoJobs := 10;
  1237. ret := ENumJobs(PrinterHD, 0, NoJobs, 1, @Job_Info, s, cbNeeded, cReturned);
  1238. Result := not((cReturned > 0) and (Job_Info[0].TotalPages > 0));
  1239. end
  1240. else
  1241. Result := True;
  1242. end;
  1243. procedure PrintTemplet;
  1244. var
  1245. sFileName: string;
  1246. begin
  1247. if isPDF then
  1248. begin
  1249. sFileName := BatchPrintXml.ReportName + '.pdf';
  1250. if SaveFile(sFileName, '.pdf') then
  1251. PdfHelper.ExportAllPages(BatchPrintXml, sFileName);
  1252. (*
  1253. BatchPrintXml.PrintPDFAll(PreviewBox.Canvas);
  1254. while not CheckPrinterReady do
  1255. Sleep(1000);
  1256. *)
  1257. end
  1258. else if not isExcel then
  1259. BatchPrintXml.PrintAll(PreviewBox.Canvas, 1)
  1260. else
  1261. ExportXlsReport(1, BatchPrintXml.TotalPages, ExcelOutputName, BatchPrintXml);
  1262. end;
  1263. var
  1264. strRptName : string;
  1265. begin
  1266. if not FileExists(ATemplateNode.FileName) then Exit;
  1267. ClearReportOprList;
  1268. ClearReportFuncList;
  1269. Screen.Cursor := crHourGlass;
  1270. try
  1271. LoadTemplet(ATemplateNode, BatchPrintXml);
  1272. if BatchPrintXml.TotalPages > 0 then
  1273. PrintTemplet
  1274. {else if strRptName <> '' then
  1275. begin
  1276. LoadTemplet(RptArchiverObj, strRptName);
  1277. PrintEmptyTemplet;
  1278. end;}
  1279. finally
  1280. Screen.Cursor := crDefault;
  1281. end;
  1282. end;
  1283. procedure TReportsForm.ExportXlsReport(AStartPage, AEndPage: Integer;
  1284. const AFileName: string; APrintCom: TPrintComXML);
  1285. procedure ExportPagesXlsReport(AStartPage, AEndPage: Integer; const AFileName: string);
  1286. var
  1287. Border : TColumnLineRec;
  1288. begin
  1289. LoadExcelBorder(Border);
  1290. if IsExcel2010 then
  1291. // 康博士代码中写批量打印是,用Printer.Canvas,打印当前时,用PreviewBox.Canvas。不懂为什么
  1292. APrintCom.OutputToExcelRangeXMLEx(PreviewBox.Canvas, AStartPage,
  1293. AEndPage, GetTemplateXlsFileName, AFileName, Border, ExcelMode)
  1294. else
  1295. APrintCom.OutputToExcelFile(PreviewBox.Canvas, AStartPage,
  1296. AEndPage, GetTemplateXlsFileName, AFileName, ExcelMode, Border);
  1297. end;
  1298. var
  1299. iStartPage, iEndPage, iCount: Integer;
  1300. sFileName: string;
  1301. begin
  1302. BeforeExport;
  1303. try
  1304. if (ExcelMode = oemNormal) and (PrintEndPage - PrintStartPage > 30) then
  1305. begin
  1306. iStartPage := PrintStartPage;
  1307. iEndPage := iStartPage + 19;
  1308. iCount := 1;
  1309. repeat
  1310. begin
  1311. sFileName := Format('%s[%d].xls', [ExtractSimpleFileName(AFileName), iCount]);
  1312. ExportPagesXlsReport(iStartPage, iEndPage, sFileName);
  1313. iStartPage := iStartPage + 20;
  1314. iEndPage := Min(iEndPage + 20, PrintEndPage);
  1315. Inc(iCount);
  1316. end
  1317. until iStartPage > iEndPage;
  1318. end
  1319. else
  1320. ExportPagesXlsReport(AStartPage, AEndPage, AFileName);
  1321. finally
  1322. AfterExport;
  1323. end;
  1324. end;
  1325. procedure TReportsForm.LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  1326. var
  1327. RptArchiverObj: TReportArchiver;
  1328. Mem: TMemoryStream;
  1329. begin
  1330. RptArchiverObj := TReportArchiver.Create;
  1331. if ATemplate.IsMulti then
  1332. RptArchiverObj.FileName := ATemplate.MultiFileNames[FProjectData.PhaseIndex]
  1333. else
  1334. RptArchiverObj.FileName := ATemplate.FileName;
  1335. Mem := RptArchiverObj.Extract;
  1336. try
  1337. // 以下代码有顺序限制,不可修改,主要保证在不修改报表模板文件的基础上可以用户定制报表格式
  1338. // 私以为,原因在于这些设置修改后,并不能生效,需要保存再读取方可生效
  1339. // 读取报表模板
  1340. if not APrintCom.ReadReportStream(Mem) then Exit;
  1341. // 将报表设置中的数据覆盖掉原模板的数据
  1342. InitReportSettings(APrintCom, ATemplate);
  1343. // 保存
  1344. APrintCom.SaveToStream(Mem);
  1345. // 再次读取,使报表设置中的设置生效
  1346. APrintCom.ReadReportStream(Mem);
  1347. // ReadReportStream之后会将PreviewComXML的FillZero值赋为True,故再赋值一次
  1348. APrintCom.FillZero := chkFillZero.Checked;
  1349. InitPageSettings(APrintCom);
  1350. APrintCom.ReadDBData;
  1351. APrintCom.AnalyseData(PreviewBox.Canvas);
  1352. finally
  1353. if Mem <> nil then
  1354. Mem.Free;
  1355. RptArchiverObj.Free;
  1356. end;
  1357. end;
  1358. function TReportsForm.GetHintStr: string;
  1359. begin
  1360. Result := #13#10 +
  1361. '对不起,学习版不提供报表打印、导出功能。'#13#10 +
  1362. #13#10 +
  1363. '以下为收费服务项目,请在必要时联系纵横:'#13#10 +
  1364. #13#10 +
  1365. '企业QQ:800003850 客服热线:(0756)3850888';
  1366. end;
  1367. function TReportsForm.GetSubClassNode(AClassNode: TExTreeNode;
  1368. ANode: TTemplateNode): TExTreeNode;
  1369. function FindNode(AParent: TExTreeNode; const AName: string): TExTreeNode;
  1370. var
  1371. I: Integer;
  1372. vNode: TExTreeNode;
  1373. begin
  1374. Result := nil;
  1375. if Assigned(AParent) then
  1376. vNode := AParent.getFirstChild
  1377. else
  1378. vNode := extvReport.Items.GetFirstNode;
  1379. while not Assigned(Result) and Assigned(vNode) do
  1380. begin
  1381. if SameText(vNode.Text, AName) then
  1382. Result := vNode;
  1383. vNode := vNode.getNextSibling;
  1384. end;
  1385. end;
  1386. begin
  1387. Result := FindNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1388. if not Assigned(Result) then
  1389. Result := AddClassNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1390. end;
  1391. function TReportsForm.AddClassNode(AParent: TExTreeNode;
  1392. const AName: string): TExTreeNode;
  1393. begin
  1394. Result := extvReport.Items.AddChildObject(AParent, AName, Pointer(nil));
  1395. Result.ImageIndex := 0;
  1396. Result.SelectedIndex := 1;
  1397. Result.Checked := csUnchecked;
  1398. Result.Expanded := True;
  1399. end;
  1400. procedure TReportsForm.SaveReportInteractData(ATemplate: TTemplateNode);
  1401. begin
  1402. case ATemplate.InteractFlag of
  1403. 1: SaveAuditOpinion(ATemplate);
  1404. end;
  1405. end;
  1406. procedure TReportsForm.SaveAuditOpinion(ATemplate: TTemplateNode);
  1407. var
  1408. SelectForm: TAuditSelctForm;
  1409. begin
  1410. SelectForm := TAuditSelctForm.Create(FProjectData, ATemplate);
  1411. try
  1412. if SelectForm.ShowModal = mrOk then
  1413. SelectForm.SaveAuditData;
  1414. finally
  1415. SelectForm.Free;
  1416. end;
  1417. end;
  1418. destructor TReportsForm.Destroy;
  1419. begin
  1420. FReportCon.Free;
  1421. FReportDataPrepare.Free;
  1422. inherited;
  1423. end;
  1424. end.