ReportsFrm.pas 43 KB

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