ReportsFrm.pas 46 KB

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