ReportsFrm.pas 44 KB

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