ReportsFrm.pas 48 KB

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