ReportsFrm.pas 48 KB

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