ReportsFrm.pas 45 KB

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