ReportsFrm.pas 44 KB

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