ReportsFrm.pas 46 KB

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