ReportsFrm.pas 49 KB

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