ReportsFrm.pas 43 KB

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