ReportsFrm.pas 47 KB

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