ReportsFrm.pas 46 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558
  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. CopyFile(PChar(AFileName), PChar(sNewFileName), True);
  609. vTemplateNode := ReportTemplateManager.AddReportTemplate(sNewFileName);
  610. AddReportTemplate(vTemplateNode);
  611. end
  612. else
  613. if QuestMessage('已存在报表模板' + ExtractFileName(AFileName) + ',是否覆盖原模板?', Handle) then
  614. begin
  615. CopyFile(PChar(AFileName), PChar(sNewFileName), False);
  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. CopyFile(PChar(vTemplateNode.FileName), PChar(sFileName), False);
  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 (FProjectData.ProjProperties.AuditStatus = -1) then
  708. APrintCom.ShowBackgroundMark := False
  709. else
  710. APrintCom.ShowBackgroundMark := True;
  711. end
  712. else
  713. APrintCom.ShowBackgroundMark := False;
  714. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShowStateText;
  715. end;
  716. procedure TReportsForm.InitPageSettings(APrintCom: TPrintComXML);
  717. begin
  718. // 设置页面大小
  719. APrintCom.setPageSize(ReportConfig.PageSize);
  720. if ReportConfig.PageSize = 'A3' then
  721. APrintCom.PrintPageSizeIdx := DMPAPER_A3
  722. else if ReportConfig.PageSize = 'A4' then
  723. APrintCom.PrintPageSizeIdx := DMPAPER_A4;
  724. // 设置边距
  725. APrintCom.setEdge(0, '', ReportConfig.LeftEdge/10);
  726. APrintCom.setEdge(1, '', ReportConfig.RightEdge/10);
  727. APrintCom.setEdge(2, '', ReportConfig.UpEdge/10);
  728. APrintCom.setEdge(3, '', ReportConfig.DownEdge/10);
  729. end;
  730. procedure TReportsForm.InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  731. procedure InitRepBorderLine;
  732. var
  733. i: Integer;
  734. ObjList : TList;
  735. ShapeRec : PPicRec;
  736. begin
  737. ObjList := TList.Create;
  738. try
  739. APrintCom.getAllShapeObjs(1, ObjList);
  740. for i := 0 to ObjList.Count - 1 do
  741. begin
  742. ShapeRec := ObjList[i];
  743. // 设置报表边框线粗
  744. ShapeRec.PenWidth := ReportConfig.BorderLine;
  745. // 设置是否绘制报表边框横线
  746. if (ShapeRec.ExArea.ExLeft <> ShapeRec.ExArea.ExRight) then
  747. begin
  748. if not ReportConfig.RepBorderUnderLine then
  749. ShapeRec.PenStyle := integer(psClear)
  750. else
  751. ShapeRec.PenStyle := integer(psSolid);
  752. end;
  753. // 设置是否绘制报表边框竖线
  754. if (ShapeRec.ExArea.ExTop <> ShapeRec.ExArea.ExBottom) and
  755. ((ShapeRec.ExArea.ExLeft = 0) or (ShapeRec.ExArea.ExLeft = 100)) then
  756. begin //这里的判断条件是约定好的
  757. if not ReportConfig.RepBorderVerLine then
  758. ShapeRec.PenStyle := integer(psClear)
  759. else
  760. ShapeRec.PenStyle := integer(psSolid)
  761. end;
  762. APrintCom.setShapeObj(ShapeRec);
  763. end;
  764. finally
  765. ObjList.Free;
  766. end;
  767. end;
  768. procedure InitRepCellLine;
  769. var
  770. i: Integer;
  771. ObjList : TList;
  772. ColumnRec : PColumnRec;
  773. FlowContentRec : PContentRec;
  774. CrossContentRec : PCrossContentRec;
  775. begin
  776. ObjList := TList.Create;
  777. try
  778. APrintCom.getAllFlowShowContentObjs(ObjList);
  779. // 设置报表表格横线
  780. for i := 0 to ObjList.Count - 1 do
  781. begin
  782. FlowContentRec := ObjList[i];
  783. FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  784. FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  785. APrintCom.setFlowContentObj(FlowContentRec);
  786. end;
  787. APrintCom.getAllCrossContentObjs(ObjList);
  788. for i := 0 to ObjList.Count - 1 do
  789. begin
  790. CrossContentRec := ObjList[i];
  791. CrossContentRec.CrossContent.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  792. CrossContentRec.CrossContent.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  793. APrintCom.setCrossContentObj(CrossContentRec);
  794. end;
  795. // 设置报表表格竖线
  796. APrintCom.getAllFlowShowContentObjs(ObjList);
  797. for i := 0 to ObjList.Count - 1 do
  798. begin
  799. FlowContentRec := ObjList[i];
  800. FlowContentRec.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  801. FlowContentRec.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  802. // 如果设置无表格边框线,则两端的表格竖线线粗为0
  803. if (not ReportConfig.RepBorderVerLine) then
  804. if (i = 0) then
  805. FlowContentRec.LineInfo.LeftThick := 0
  806. else if (i = ObjList.Count - 1) then
  807. FlowContentRec.LineInfo.RightThick := 0;
  808. APrintCom.setFlowContentObj(FlowContentRec);
  809. end;
  810. APrintCom.getAllCrossContentObjs(ObjList);
  811. for i := 0 to ObjList.Count - 1 do
  812. begin
  813. CrossContentRec := ObjList[i];
  814. CrossContentRec.CrossContent.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  815. CrossContentRec.CrossContent.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  816. ColumnRec := CrossContentRec.CrossContent.Column;
  817. //这里还要判断如果没有边框竖线的情况下,表格竖线边缘的线粗也为0
  818. //前提是所属表栏最右位置位于边缘
  819. if (not ReportConfig.RepBorderVerLine) and (ColumnRec<>nil) and
  820. ((ColumnRec.ExArea.ExRight = 100.0) or (ColumnRec.ExArea.ExLeft = 0.0)) then
  821. begin
  822. case CrossContentRec.CrossType of
  823. 0 : //交叉行
  824. begin
  825. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  826. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  827. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  828. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  829. end;
  830. 1 : //交叉列
  831. begin
  832. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  833. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  834. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  835. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  836. //(*
  837. if (CrossContentRec.CrossContent.isSpecialBorder) then
  838. begin
  839. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  840. CrossContentRec.CrossContent.SpecialLineInfo.RightThick := 0;
  841. end;
  842. //*)
  843. end;
  844. 2 : //显示数据
  845. begin
  846. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  847. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  848. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  849. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  850. end;
  851. 3 : //固定LABEL
  852. begin
  853. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  854. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  855. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  856. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  857. end;
  858. 4 : //序号
  859. begin
  860. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  861. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  862. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  863. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  864. end;
  865. 5 : //横向统计
  866. begin
  867. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  868. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  869. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  870. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  871. end;
  872. end;
  873. end;
  874. APrintCom.setCrossContentObj(CrossContentRec);
  875. end;
  876. finally
  877. ObjList.Free;
  878. end;
  879. end;
  880. procedure InitOtherArea;
  881. procedure SetPTRBorder(PTR : PTextRec);
  882. procedure SetLeftRightBorder;
  883. begin
  884. if PTR.ExArea.ExLeft = 0.0 then
  885. begin
  886. if BorderWidth = 0.0 then
  887. PTR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth;
  888. end;
  889. if PTR.ExArea.ExRight = 100.0 then
  890. begin
  891. if BorderWidth = 0.0 then
  892. PTR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth
  893. end;
  894. end;
  895. procedure SetHorLine;
  896. begin
  897. if (PTR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  898. PTR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  899. if (PTR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  900. PTR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  901. end;
  902. begin
  903. SetLeftRightBorder;
  904. SetHorLine;
  905. end;
  906. procedure SetPCRBorder(PCR : PColumnRec);
  907. procedure SetLeftRightBorder;
  908. begin
  909. if PCR.ExArea.ExLeft = 0.0 then
  910. begin
  911. if BorderWidth = 0.0 then
  912. PCR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth
  913. end;
  914. if PCR.ExArea.ExRight = 100.0 then
  915. begin
  916. if BorderWidth = 0.0 then
  917. PCR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth;
  918. end;
  919. end;
  920. procedure SetVerLine;
  921. begin
  922. if PCR.ExArea.ExLeft = 0.0 then
  923. PCR.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  924. if PCR.ExArea.ExRight = 100.0 then
  925. PCR.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  926. end;
  927. procedure SetHorLine;
  928. begin
  929. if (PCR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  930. PCR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  931. if (PCR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  932. PCR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  933. end;
  934. begin
  935. SetLeftRightBorder;
  936. SetVerLine;
  937. SetHorLine;
  938. end;
  939. var i,k : integer;
  940. ObjList : TList;
  941. ActAreaRec : PActiveAreaRec;
  942. PSR : PShowElementRec;
  943. begin
  944. ObjList := TList.Create;
  945. try
  946. ActAreaRec := nil;
  947. PreviewComXML.getAllActAreaObjs(ObjList);
  948. for i := 0 to ObjList.Count - 1 do
  949. begin
  950. ActAreaRec := ObjList[i];
  951. if (ActAreaRec.ShowType < 0) or (ActAreaRec.ShowType > 2) then Continue;
  952. if not Assigned(ActAreaRec.ElementList) then Continue;
  953. for k := 0 to ActAreaRec.ElementList.Count - 1 do
  954. begin
  955. PSR := PShowElementRec(ActAreaRec.ElementList[k]);
  956. case PSR.ElementType of
  957. 0..2 : SetPTRBorder(PSR.Data); //文本,参数,字段,表栏
  958. 7 : SetPCRBorder(PSR.Data) //Column
  959. end;
  960. APrintCom.setActShowElementObj(PSR);
  961. end;
  962. end;
  963. finally
  964. ObjList.Free;
  965. end;
  966. end;
  967. begin
  968. if not Assigned(ATemplate) or (ATemplate.SelfFormat = 0) then
  969. begin
  970. InitFont(APrintCom); // 各类字体
  971. InitRepBorderLine; // 报表边框
  972. InitRepCellLine; // 报表表格
  973. InitOtherArea; // 活动区域
  974. end;
  975. end;
  976. procedure TReportsForm.PreviewComXMLCrossTabLabelShow(valIDX: Integer;
  977. var ExLeft, ExRight: Double; var isShow: Boolean;
  978. CrsTabShowType: Integer);
  979. var field : PFieldRec;
  980. begin
  981. if (CrsTabShowType = -1) then exit;
  982. field := PreviewComXML.getFieldByID(6);
  983. if (field <> nil) then
  984. begin
  985. if (field.DataLen > valIDX) and (valIDX >= 0) then
  986. begin
  987. if (field.Value[valIDX] = 1.5) then
  988. begin
  989. case CrsTabShowType of
  990. 1 : begin
  991. isShow := false;
  992. end;
  993. 2 : begin
  994. ExLeft := 0;
  995. ExRight := 100;
  996. end;
  997. 3 : begin
  998. //
  999. end
  1000. else
  1001. begin
  1002. //
  1003. end;
  1004. end;
  1005. end;
  1006. end;
  1007. end;
  1008. end;
  1009. procedure TReportsForm.rdbtnA4Click(Sender: TObject);
  1010. begin
  1011. ReportConfig.PageSize := TRadioButton(Sender).Caption;
  1012. SetPrinterPageSize(ReportConfig.PageSize);
  1013. LoadTempletAndDisplay;
  1014. end;
  1015. procedure TReportsForm.chkFillZeroClick(Sender: TObject);
  1016. begin
  1017. PreviewComXML.FillZero := chkFillZero.Checked;
  1018. PreviewReportCurPage;
  1019. end;
  1020. procedure TReportsForm.InitFont(APrintCom: TPrintComXML);
  1021. procedure AssignFontRec(AFontRec: TFontRec; AFont: TFont);
  1022. begin
  1023. AFontRec.FontName := AFont.Name;
  1024. AFontRec.FontHeight := Round(AFont.Size*4/3) ;
  1025. AFontRec.FontBold := 400 + Integer(fsBold in AFont.Style)*200;
  1026. AFontRec.FontItalic := Integer(fsItalic in AFont.Style);
  1027. AFontRec.FontUnderLine := Integer(fsUnderLine in AFont.Style);
  1028. end;
  1029. procedure InitTitleFont;
  1030. var
  1031. TitleRec : PTitleRec;
  1032. begin
  1033. TitleRec := PreviewComXML.getTitleByID(1);
  1034. if TitleRec <> nil then
  1035. begin
  1036. AssignFontRec(TitleRec.FontRec, ReportConfig.TitleFont);
  1037. APrintCom.setTitleObj(TitleRec);
  1038. end;
  1039. end;
  1040. procedure InitColumnFont;
  1041. procedure InitColumnThick(AColumnRec: PColumnRec);
  1042. begin
  1043. if (ReportConfig.ReportCellLine > 0.2) then
  1044. begin
  1045. if (AColumnRec.LineInfo.LeftThick > 0.2) then
  1046. AColumnRec.LineInfo.LeftThick := ReportConfig.ReportCellLine;
  1047. if (AColumnRec.LineInfo.RightThick > 0.2) then
  1048. AColumnRec.LineInfo.RightThick := ReportConfig.ReportCellLine;
  1049. if (AColumnRec.LineInfo.TopThick > 0.2) then
  1050. AColumnRec.LineInfo.TopThick := ReportConfig.ReportCellLine;
  1051. if (AColumnRec.LineInfo.BottomThick > 0.2) then
  1052. AColumnRec.LineInfo.BottomThick := ReportConfig.ReportCellLine;
  1053. end;
  1054. end;
  1055. var
  1056. i, j: Integer;
  1057. ObjList: TList;
  1058. ColumnRec : PColumnRec;
  1059. AAR : PActiveAreaRec;
  1060. SER : PShowElementRec;
  1061. begin
  1062. ObjList := TList.Create;
  1063. try
  1064. APrintCom.getAllColumnHeadObjs(ObjList);
  1065. for i := 0 to ObjList.Count - 1 do
  1066. begin
  1067. ColumnRec := ObjList[i];
  1068. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1069. InitColumnThick(ColumnRec);
  1070. APrintCom.setColumnHeadTailObj(0, ColumnRec);
  1071. end;
  1072. APrintCom.getAllColumnTailObjs(ObjList);
  1073. for i := 0 to ObjList.Count - 1 do
  1074. begin
  1075. ColumnRec := ObjList[i];
  1076. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1077. InitColumnThick(ColumnRec);
  1078. APrintCom.setColumnHeadTailObj(1,ColumnRec);
  1079. end;
  1080. APrintCom.getAllActAreaObjs(ObjList);
  1081. for i := 0 to ObjList.Count - 1 do
  1082. begin
  1083. AAR := ObjList[i];
  1084. for j := 0 to AAR.ElementList.Count - 1 do
  1085. begin
  1086. SER := AAR.ElementList[j];
  1087. if (SER.ElementType = 7) then
  1088. begin
  1089. ColumnRec := SER.Data;
  1090. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1091. InitColumnThick(ColumnRec);
  1092. APrintCom.setActShowElementObj(SER);
  1093. end;
  1094. end;
  1095. end;
  1096. finally
  1097. ObjList.Free;
  1098. end;
  1099. end;
  1100. procedure InitContentAndGatherFont;
  1101. var
  1102. i, j: Integer;
  1103. ObjList: TList;
  1104. FlowContentRec : PContentRec;
  1105. CrossContentRec : PCrossContentRec;
  1106. SumRec : PSumRec;
  1107. begin
  1108. ObjList := TList.Create;
  1109. try
  1110. // 设置表正文
  1111. APrintCom.getAllFlowShowContentObjs(ObjList);
  1112. for i := 0 to ObjList.Count - 1 do
  1113. begin
  1114. FlowContentRec := ObjList[i];
  1115. if not (FlowContentRec.Fixed) then
  1116. begin
  1117. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1118. APrintCom.setFlowContentObj(FlowContentRec);
  1119. end;
  1120. end;
  1121. APrintCom.getAllBillShowContentObjs(ObjList);
  1122. for i := 0 to ObjList.Count - 1 do
  1123. begin
  1124. FlowContentRec := ObjList[i];
  1125. if not(FlowContentRec.Fixed) then
  1126. begin
  1127. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1128. APrintCom.setBillContentObj(FlowContentRec);
  1129. end;
  1130. end;
  1131. APrintCom.getAllCrossContentObjs(ObjList);
  1132. for i := 0 to ObjList.Count - 1 do
  1133. begin
  1134. CrossContentRec := ObjList[i];
  1135. if not(CrossContentRec.CrossContent.Fixed) then
  1136. begin
  1137. AssignFontRec(CrossContentRec.CrossContent.FontRec, ReportConfig.ContentFont);
  1138. APrintCom.setCrossContentObj(CrossContentRec);
  1139. end;
  1140. end;
  1141. // 设置表合计
  1142. for i := 0 to 2 do
  1143. begin
  1144. APrintCom.getAllSumObjs(i,ObjList);
  1145. for j := 0 to ObjList.Count - 1 do
  1146. begin
  1147. SumRec := ObjList[j];
  1148. AssignFontRec(SumRec.FontRec, ReportConfig.GatherFont);
  1149. APrintCom.setSumObj(SumRec);
  1150. end;
  1151. end;
  1152. finally
  1153. ObjList.Free;
  1154. end;
  1155. end;
  1156. procedure InitGridHeaderFont;
  1157. var
  1158. i: Integer;
  1159. ObjList: TList;
  1160. HeadTailRec : PHeadRec;
  1161. begin
  1162. ObjList := TList.Create;
  1163. try
  1164. APrintCom.getAllHeadObjs(ObjList);
  1165. for i := 0 to ObjList.Count - 1 do
  1166. begin
  1167. HeadTailRec := ObjList[i];
  1168. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1169. APrintCom.setHeadTailObj(0, HeadTailRec);
  1170. end;
  1171. APrintCom.getAllTailObjs(ObjList);
  1172. for i := 0 to ObjList.Count - 1 do
  1173. begin
  1174. HeadTailRec := ObjList[i];
  1175. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1176. APrintCom.setHeadTailObj(1, HeadTailRec);
  1177. end;
  1178. finally
  1179. ObjList.Free;
  1180. end;
  1181. end;
  1182. begin
  1183. InitTitleFont;
  1184. InitColumnFont;
  1185. InitContentAndGatherFont;
  1186. InitGridHeaderFont;
  1187. end;
  1188. procedure TReportsForm.PreviewComXMLGetDatasetEvent(
  1189. DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet);
  1190. begin
  1191. if DatasetInfo.ID = 0 then
  1192. ADataSet := MemoryReportManager.GetSqlResultDataSet(ReportTemplateManager.Current.InteractInfo.Sql, FProjectData)
  1193. else
  1194. ADataset := MemoryReportManager.GetMemoryDataSet(DatasetInfo.ID, FProjectData);
  1195. end;
  1196. function TReportsForm.GetIsExcel2010: Boolean;
  1197. begin
  1198. Result := chkExcel2010.Checked;
  1199. end;
  1200. procedure TReportsForm.InitFormView;
  1201. begin
  1202. rdbtnA3.Checked := SameText(rdbtnA3.Caption, ReportConfig.PageSize);
  1203. rdbtnA4.Checked := SameText(rdbtnA4.Caption, ReportConfig.PageSize);
  1204. SetPrinterPageSize(ReportConfig.PageSize);
  1205. end;
  1206. procedure TReportsForm.LoadExcelBorder(var Border: TColumnLineRec);
  1207. begin
  1208. Border.LeftThick := 0.5;
  1209. Border.TopThick := 0.5;
  1210. Border.RightThick := 0.5;
  1211. Border.BottomThick := 0.5;
  1212. if not ReportConfig.RepBorderVerLine then
  1213. begin
  1214. Border.LeftThick := 0;
  1215. Border.RightThick := 0;
  1216. end;
  1217. end;
  1218. procedure TReportsForm.PrintReport(ATemplateNode: TTemplateNode;
  1219. isPDF, isExcel: boolean; ExcelOutputName, TemplateFileName: string);
  1220. function CheckPrinterReady: Boolean;
  1221. var
  1222. PrinterHD: THandle;
  1223. NoJobs: Word;
  1224. s: LongWord;
  1225. Job_Info: Array[0..10] of Job_INFO_1;
  1226. cbNeeded: Cardinal;
  1227. cReturned: Cardinal;
  1228. ret: LongBool;
  1229. begin
  1230. if OpenPrinter(PChar(Printer.Printers[Printer.PrinterIndex]), PrinterHD, 0) then
  1231. begin
  1232. s := SizeOf(Job_Info);
  1233. cbNeeded := 0;
  1234. cReturned := 0;
  1235. NoJobs := 10;
  1236. ret := ENumJobs(PrinterHD, 0, NoJobs, 1, @Job_Info, s, cbNeeded, cReturned);
  1237. Result := not((cReturned > 0) and (Job_Info[0].TotalPages > 0));
  1238. end
  1239. else
  1240. Result := True;
  1241. end;
  1242. procedure PrintTemplet;
  1243. var
  1244. sFileName: string;
  1245. begin
  1246. if isPDF then
  1247. begin
  1248. sFileName := BatchPrintXml.ReportName + '.pdf';
  1249. if SaveFile(sFileName, '.pdf') then
  1250. PdfHelper.ExportAllPages(BatchPrintXml, sFileName);
  1251. (*
  1252. BatchPrintXml.PrintPDFAll(PreviewBox.Canvas);
  1253. while not CheckPrinterReady do
  1254. Sleep(1000);
  1255. *)
  1256. end
  1257. else if not isExcel then
  1258. BatchPrintXml.PrintAll(PreviewBox.Canvas, 1)
  1259. else
  1260. ExportXlsReport(1, BatchPrintXml.TotalPages, ExcelOutputName, BatchPrintXml);
  1261. end;
  1262. var
  1263. strRptName : string;
  1264. begin
  1265. if not FileExists(ATemplateNode.FileName) then Exit;
  1266. ClearReportOprList;
  1267. ClearReportFuncList;
  1268. Screen.Cursor := crHourGlass;
  1269. try
  1270. LoadTemplet(ATemplateNode, BatchPrintXml);
  1271. if BatchPrintXml.TotalPages > 0 then
  1272. PrintTemplet
  1273. {else if strRptName <> '' then
  1274. begin
  1275. LoadTemplet(RptArchiverObj, strRptName);
  1276. PrintEmptyTemplet;
  1277. end;}
  1278. finally
  1279. Screen.Cursor := crDefault;
  1280. end;
  1281. end;
  1282. procedure TReportsForm.ExportXlsReport(AStartPage, AEndPage: Integer;
  1283. const AFileName: string; APrintCom: TPrintComXML);
  1284. procedure ExportPagesXlsReport(AStartPage, AEndPage: Integer; const AFileName: string);
  1285. var
  1286. Border : TColumnLineRec;
  1287. begin
  1288. LoadExcelBorder(Border);
  1289. if IsExcel2010 then
  1290. // 康博士代码中写批量打印是,用Printer.Canvas,打印当前时,用PreviewBox.Canvas。不懂为什么
  1291. APrintCom.OutputToExcelRangeXMLEx(PreviewBox.Canvas, AStartPage,
  1292. AEndPage, GetTemplateXlsFileName, AFileName, Border, ExcelMode)
  1293. else
  1294. APrintCom.OutputToExcelFile(PreviewBox.Canvas, AStartPage,
  1295. AEndPage, GetTemplateXlsFileName, AFileName, ExcelMode, Border);
  1296. end;
  1297. var
  1298. iStartPage, iEndPage, iCount: Integer;
  1299. sFileName: string;
  1300. begin
  1301. BeforeExport;
  1302. try
  1303. if (ExcelMode = oemNormal) and (PrintEndPage - PrintStartPage > 30) then
  1304. begin
  1305. iStartPage := PrintStartPage;
  1306. iEndPage := iStartPage + 19;
  1307. iCount := 1;
  1308. repeat
  1309. begin
  1310. sFileName := Format('%s[%d].xls', [ExtractSimpleFileName(AFileName), iCount]);
  1311. ExportPagesXlsReport(iStartPage, iEndPage, sFileName);
  1312. iStartPage := iStartPage + 20;
  1313. iEndPage := Min(iEndPage + 20, PrintEndPage);
  1314. Inc(iCount);
  1315. end
  1316. until iStartPage > iEndPage;
  1317. end
  1318. else
  1319. ExportPagesXlsReport(AStartPage, AEndPage, AFileName);
  1320. finally
  1321. AfterExport;
  1322. end;
  1323. end;
  1324. procedure TReportsForm.LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  1325. var
  1326. RptArchiverObj: TReportArchiver;
  1327. Mem: TMemoryStream;
  1328. begin
  1329. RptArchiverObj := TReportArchiver.Create;
  1330. if ATemplate.IsMulti then
  1331. RptArchiverObj.FileName := ATemplate.MultiFileNames[FProjectData.PhaseIndex]
  1332. else
  1333. RptArchiverObj.FileName := ATemplate.FileName;
  1334. Mem := RptArchiverObj.Extract;
  1335. try
  1336. // 以下代码有顺序限制,不可修改,主要保证在不修改报表模板文件的基础上可以用户定制报表格式
  1337. // 私以为,原因在于这些设置修改后,并不能生效,需要保存再读取方可生效
  1338. // 读取报表模板
  1339. if not APrintCom.ReadReportStream(Mem) then Exit;
  1340. // 将报表设置中的数据覆盖掉原模板的数据
  1341. InitReportSettings(APrintCom, ATemplate);
  1342. // 保存
  1343. APrintCom.SaveToStream(Mem);
  1344. // 再次读取,使报表设置中的设置生效
  1345. APrintCom.ReadReportStream(Mem);
  1346. // ReadReportStream之后会将PreviewComXML的FillZero值赋为True,故再赋值一次
  1347. APrintCom.FillZero := chkFillZero.Checked;
  1348. InitPageSettings(APrintCom);
  1349. APrintCom.ReadDBData;
  1350. APrintCom.AnalyseData(PreviewBox.Canvas);
  1351. finally
  1352. if Mem <> nil then
  1353. Mem.Free;
  1354. RptArchiverObj.Free;
  1355. end;
  1356. end;
  1357. function TReportsForm.GetHintStr: string;
  1358. begin
  1359. Result := #13#10 +
  1360. '对不起,学习版不提供报表打印、导出功能。'#13#10 +
  1361. #13#10 +
  1362. '以下为收费服务项目,请在必要时联系纵横:'#13#10 +
  1363. #13#10 +
  1364. '企业QQ:800003850 客服热线:(0756)3850888';
  1365. end;
  1366. function TReportsForm.GetSubClassNode(AClassNode: TExTreeNode;
  1367. ANode: TTemplateNode): TExTreeNode;
  1368. function FindNode(AParent: TExTreeNode; const AName: string): TExTreeNode;
  1369. var
  1370. I: Integer;
  1371. vNode: TExTreeNode;
  1372. begin
  1373. Result := nil;
  1374. if Assigned(AParent) then
  1375. vNode := AParent.getFirstChild
  1376. else
  1377. vNode := extvReport.Items.GetFirstNode;
  1378. while not Assigned(Result) and Assigned(vNode) do
  1379. begin
  1380. if SameText(vNode.Text, AName) then
  1381. Result := vNode;
  1382. vNode := vNode.getNextSibling;
  1383. end;
  1384. end;
  1385. begin
  1386. Result := FindNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1387. if not Assigned(Result) then
  1388. Result := AddClassNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1389. end;
  1390. function TReportsForm.AddClassNode(AParent: TExTreeNode;
  1391. const AName: string): TExTreeNode;
  1392. begin
  1393. Result := extvReport.Items.AddChildObject(AParent, AName, Pointer(nil));
  1394. Result.ImageIndex := 0;
  1395. Result.SelectedIndex := 1;
  1396. Result.Checked := csUnchecked;
  1397. Result.Expanded := True;
  1398. end;
  1399. procedure TReportsForm.SaveReportInteractData(ATemplate: TTemplateNode);
  1400. begin
  1401. case ATemplate.InteractFlag of
  1402. 1: SaveAuditOpinion(ATemplate);
  1403. end;
  1404. end;
  1405. procedure TReportsForm.SaveAuditOpinion(ATemplate: TTemplateNode);
  1406. var
  1407. SelectForm: TAuditSelctForm;
  1408. begin
  1409. SelectForm := TAuditSelctForm.Create(FProjectData, ATemplate);
  1410. try
  1411. if SelectForm.ShowModal = mrOk then
  1412. SelectForm.SaveAuditData;
  1413. finally
  1414. SelectForm.Free;
  1415. end;
  1416. end;
  1417. destructor TReportsForm.Destroy;
  1418. begin
  1419. FReportCon.Free;
  1420. FReportDataPrepare.Free;
  1421. inherited;
  1422. end;
  1423. end.