ReportsFrm.pas 53 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777
  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, ExcelOutput,
  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. btnRMgr: TToolButton;
  61. pnlSearch: TPanel;
  62. imgSearch: TImage;
  63. edtSearch: TEdit;
  64. procedure PreviewComXMLGetDataConnection(var ADOCon: TADOConnection);
  65. procedure xlbRealSizeClick(Sender: TObject);
  66. procedure xlbOnePageClick(Sender: TObject);
  67. procedure xlbTwoPageClick(Sender: TObject);
  68. procedure xlbFourPageClick(Sender: TObject);
  69. procedure xlbFirstPageClick(Sender: TObject);
  70. procedure xlbPrePageClick(Sender: TObject);
  71. procedure xlbNextPageClick(Sender: TObject);
  72. procedure xlbLastPageClick(Sender: TObject);
  73. procedure xcbPagesChange(Sender: TObject);
  74. procedure xlbPrintCurPageClick(Sender: TObject);
  75. procedure xcbStartPageChange(Sender: TObject);
  76. procedure xlbPrintClick(Sender: TObject);
  77. procedure xlbToPDFClick(Sender: TObject);
  78. procedure xlbToExcelClick(Sender: TObject);
  79. procedure extvReportClick(Sender: TObject);
  80. procedure xlbCloseClick(Sender: TObject);
  81. procedure tbImportSrtClick(Sender: TObject);
  82. procedure tbDeleteSrtClick(Sender: TObject);
  83. procedure tbExportSrtClick(Sender: TObject);
  84. procedure PreviewComXMLContentDisplay(var contentFontRec: TFontRec;
  85. dataType: Integer; isReading: Boolean; DrawType: Integer;
  86. isPrinting: Boolean);
  87. procedure xlbSetupClick(Sender: TObject);
  88. procedure PreviewComXMLCrossTabLabelShow(valIDX: Integer; var ExLeft,
  89. ExRight: Double; var isShow: Boolean; CrsTabShowType: Integer);
  90. procedure rdbtnA4Click(Sender: TObject);
  91. procedure chkFillZeroClick(Sender: TObject);
  92. procedure PreviewComXMLGetDatasetEvent(DatasetInfo: PDatasetInfoRec;
  93. var ADataset: TDataSet);
  94. procedure btnRMgrClick(Sender: TObject);
  95. procedure FormActivate(Sender: TObject);
  96. procedure imgSearchClick(Sender: TObject);
  97. procedure extvReportKeyDown(Sender: TObject; var Key: Word;
  98. Shift: TShiftState);
  99. private
  100. FProjectData: TProjectData;
  101. FCurPage: Integer;
  102. FiPageGroup: Integer;
  103. FiCenterPerPage: Integer;
  104. FbNormal : Boolean;
  105. FDisplayCount: Integer;
  106. FLockForm: Boolean;
  107. // 数据库管理
  108. FReportCon: TReportConnection;
  109. // 报表数据准备
  110. FReportDataPrepare: TReportPrepare;
  111. procedure InitPageSettings(APrintCom: TPrintComXML);
  112. procedure InitFont(APrintCom: TPrintComXML);
  113. procedure InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  114. function GetHintStr: string;
  115. function AddClassNode(AParent: TExTreeNode; const AName: string): TExTreeNode;
  116. function GetClassNode(ANode: TTemplateNode): TExTreeNode;
  117. function GetSubClassNode(AClassNode: TExTreeNode; ANode: TTemplateNode): TExTreeNode;
  118. procedure AddReportTemplate(ANode: TTemplateNode);
  119. procedure LoadReportTemplets;
  120. procedure SaveAuditOpinion(ATemplate: TTemplateNode);
  121. procedure SaveReportInteractData(ATemplate: TTemplateNode);
  122. procedure ResizePreviewBox;
  123. procedure PreviewReportCurPage;
  124. procedure RepaintCurPagePreview;
  125. procedure LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  126. procedure LoadTempletAndDisplay;
  127. procedure BeforeExport;
  128. procedure AfterExport;
  129. procedure LoadExcelBorder(var Border : TColumnLineRec);
  130. procedure PrintReport(ATemplateNode: TTemplateNode; isPDF, isExcel: boolean;
  131. ExcelOutputName, TemplateFileName: string);
  132. procedure ExportXlsReport(AStartPage, AEndPage: Integer; const AFileName: string; APrintCom: TPrintComXML);
  133. procedure ExportCurXlsReport;
  134. procedure ExportAllSelectedXlsReports;
  135. procedure PrintAllSelectedReports;
  136. procedure ExportAllSelectedPDFReports;
  137. procedure ExportReportPage(APage: Integer; const APageFileName: string; AOrg: Boolean);
  138. procedure SetProjectData(const Value: TProjectData);
  139. procedure SetCurPage(const Value: Integer);
  140. function GetPrintEndPage: Integer;
  141. function GetPrintStartPage: Integer;
  142. function GetPageCount: Integer;
  143. function GetPrecededCount: Integer;
  144. function GetExcelMode: TOutputExcelMode;
  145. function GetIsExcel2010: Boolean;
  146. function GetSysTempDirectory : String;
  147. public
  148. destructor Destroy; override;
  149. procedure RefreshReportTemplets;
  150. procedure InitFormView;
  151. procedure InitReportSettings(APrintCom: TPrintComXML; ATemplate: TTemplateNode = nil);
  152. property ProjectData: TProjectData read FProjectData write SetProjectData;
  153. // 当前预览的页码
  154. property CurPage: Integer read FCurPage write SetCurPage;
  155. // 显示几页
  156. property DisplayCount: Integer read FDisplayCount write FDisplayCount;
  157. // 翻到的页数(例如:当前显示9页,显示4页,则翻到的页数为3)
  158. property PrecededCount: Integer read GetPrecededCount;
  159. property PrintStartPage: Integer read GetPrintStartPage;
  160. property PrintEndPage: Integer read GetPrintEndPage;
  161. property PageCount: Integer read GetPageCount;
  162. property ExcelMode: TOutputExcelMode read GetExcelMode;
  163. property IsExcel2010: Boolean read GetIsExcel2010;
  164. property LockForm: Boolean read FLockForm write FLockForm;
  165. end;
  166. procedure DisplayReportsForm(AProjectData: TProjectData);
  167. implementation
  168. uses
  169. UtilMethods, Math, Globals, ZhAPI, ReportAdjustFrm,
  170. Contnrs, mEncryptUnit, Printers, WinSpool, MainFrm, ConstUnit,
  171. GclBillsGatherModel, ReportPdfHelper, ReportManagerFrm, ReportManagerDM;
  172. {$R *.dfm}
  173. procedure DisplayReportsForm(AProjectData: TProjectData);
  174. var
  175. ReportsForm: TReportsForm;
  176. begin
  177. ReportsForm := TReportsForm.Create(nil);
  178. {ReportsForm.BorderIcons := ReportsForm.BorderIcons - [biMaximize];
  179. ReportsForm.WindowState := wsMaximized;}
  180. ReportsForm.ProjectData := AProjectData;
  181. ReportsForm.InitReportSettings(ReportsForm.PreviewComXML);
  182. ReportsForm.InitFormView;
  183. try
  184. if not _IsDebugView then
  185. ReportsForm.extvReport.OnKeyDown := nil;
  186. ReportsForm.ShowModal;
  187. finally
  188. ReportsForm.Free;
  189. if not _IsDebugView then
  190. AProjectData.ClearReportCacheData;
  191. end;
  192. end;
  193. { TReportsForm }
  194. procedure TReportsForm.LoadReportTemplets;
  195. var
  196. iTemplate: Integer;
  197. TemplateNode: TTemplateNode;
  198. ClassNode: TExTreeNode;
  199. begin
  200. extvReport.Items.Clear;
  201. for iTemplate := 0 to ReportTemplateManager.Count - 1 do
  202. begin
  203. TemplateNode := ReportTemplateManager.Template[iTemplate];
  204. AddReportTemplate(TemplateNode);
  205. end;
  206. extvReport.AlphaSort;
  207. // 强制展开全部节点
  208. // 某些情况下,创建节点处的展开方法失效
  209. ClassNode := extvReport.Items.GetFirstNode;
  210. while Assigned(ClassNode) do
  211. begin
  212. ClassNode.ForcedExpand(True);
  213. ClassNode := ClassNode.getNextSibling;
  214. end;
  215. extvReport.Selected := extvReport.Items.GetFirstNode;
  216. end;
  217. procedure TReportsForm.LoadTempletAndDisplay;
  218. procedure ResetReportsVariant;
  219. var
  220. iPage: Integer;
  221. begin
  222. FbNormal := False;
  223. xcbPages.Items.Clear;
  224. for iPage := 1 to PreviewComXML.TotalPages do
  225. xcbPages.Items.Add(IntToStr(iPage));
  226. xcbStartPage.Items.Assign(xcbPages.Items);
  227. xcbStartPage.ItemIndex := 0;
  228. xcbEndPage.Items.Assign(xcbPages.Items);
  229. xcbEndPage.ItemIndex := xcbEndPage.Items.Count - 1;
  230. xlbRealSize.Down := True;
  231. DisplayCount := 1;
  232. CurPage := 1;
  233. end;
  234. procedure WaringAndEmptyPreview(AStr: string);
  235. var
  236. OldBrushColor, OldPenColor: TColor;
  237. begin
  238. TipMessage(AStr, Handle);
  239. OldBrushColor := PreviewBox.Canvas.Brush.Color;
  240. OldPenColor := PreviewBox.Canvas.Pen.Color;
  241. try
  242. PreviewBox.Canvas.Brush.Color := clBtnFace;
  243. PreviewBox.Canvas.Pen.Color := clBlack;
  244. PreviewBox.Canvas.Rectangle(PreviewBox.BoundsRect);
  245. finally
  246. PreviewBox.Canvas.Brush.Color := OldBrushColor;
  247. PreviewBox.Canvas.Pen.Color := OldPenColor;
  248. end;
  249. end;
  250. procedure PreviewTemplet;
  251. begin
  252. try
  253. ResizePreviewBox;
  254. ResetReportsVariant;
  255. except
  256. WaringAndEmptyPreview('当前报表显示可能存在问题,请与纵横客服中心联系:(0756)3850888。');
  257. end;
  258. end;
  259. procedure LoadEmptyTempletAndDisplay;
  260. begin
  261. WaringAndEmptyPreview('报表无数据,请选择其他报表。');
  262. end;
  263. var
  264. vTemplateNode: TTemplateNode;
  265. pNode: PTemplateNode;
  266. begin
  267. if not Assigned(extvReport.Selected) then Exit;
  268. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  269. if not Assigned(vTemplateNode) then Exit;
  270. ReportTemplateManager.Current := vTemplateNode;
  271. // 交互表
  272. if vTemplateNode.InteractFlag <> 0 then
  273. SaveReportInteractData(vTemplateNode);
  274. // 准备额外数据
  275. if vTemplateNode.DataPrepareFlag <> 0 then
  276. FReportDataPrepare.PrepareData(vTemplateNode.DataPrepareFlag);
  277. FReportCon.RefreshConnection(vTemplateNode);
  278. Screen.Cursor := crHourGlass;
  279. try
  280. LoadTemplet(vTemplateNode, PreviewComXML);
  281. if PreviewComXML.TotalPages > 0 then
  282. PreviewTemplet
  283. else
  284. LoadEmptyTempletAndDisplay;
  285. finally
  286. Screen.Cursor := crDefault;
  287. end;
  288. end;
  289. procedure TReportsForm.SetProjectData(const Value: TProjectData);
  290. begin
  291. FProjectData := Value;
  292. FReportDataPrepare := TReportPrepare.Create(FProjectData);
  293. FReportCon := TReportConnection.Create(FProjectData);
  294. extvReport.Selected := extvReport.Items[0];
  295. LoadReportTemplets;
  296. LoadTempletAndDisplay;
  297. end;
  298. procedure TReportsForm.PreviewComXMLGetDataConnection(
  299. var ADOCon: TADOConnection);
  300. begin
  301. ADOCon := FReportCon.Connection;
  302. end;
  303. procedure TReportsForm.PreviewReportCurPage;
  304. begin
  305. if FbNormal then
  306. PreviewComXML.PrintPreviewCanvas(-1, PrecededCount, PreviewBox.Canvas, True)
  307. else //强制1:1显示
  308. PreviewComXML.PrintPreviewCanvas(CurPage, 0, PreviewBox.Canvas, True);
  309. end;
  310. procedure TReportsForm.ResizePreviewBox;
  311. var
  312. iHeight, iWidth: Integer;
  313. begin
  314. if FbNormal then
  315. begin
  316. iHeight := sbReportsPreview.ClientHeight;
  317. iWidth := sbReportsPreview.ClientWidth;
  318. end
  319. else
  320. begin
  321. iHeight := Max(PreviewComXML.PrintHeight + 20, sbReportsPreview.ClientHeight);
  322. iWidth := Max(PreviewComXML.PrintWidth + 20, sbReportsPreview.ClientWidth);
  323. end;
  324. if PreviewBox.Height <> iHeight then
  325. begin
  326. PreviewBox.Height := iHeight;
  327. PreviewBox.Picture.Bitmap.Height := iHeight;
  328. end;
  329. if PreviewBox.Width <> iWidth then
  330. begin
  331. PreviewBox.Width := iWidth;
  332. PreviewBox.Picture.Bitmap.Width := iWidth;
  333. end;
  334. end;
  335. procedure TReportsForm.RepaintCurPagePreview;
  336. begin
  337. ResizePreviewBox;
  338. PreviewReportCurPage;
  339. end;
  340. procedure TReportsForm.xlbRealSizeClick(Sender: TObject);
  341. begin
  342. FbNormal := False;
  343. DisplayCount := TdxBarLargeButton(Sender).Tag;
  344. RepaintCurPagePreview;
  345. end;
  346. procedure TReportsForm.xlbOnePageClick(Sender: TObject);
  347. begin
  348. PreviewComXML.PreviewRows := 1;
  349. PreviewComXML.PreviewCols := 1;
  350. DisplayCount := TdxBarLargeButton(Sender).Tag;
  351. FbNormal := True;
  352. RepaintCurPagePreview;
  353. end;
  354. procedure TReportsForm.xlbTwoPageClick(Sender: TObject);
  355. begin
  356. if PreviewComXML.ReportSize.X > PreviewComXML.ReportSize.Y then
  357. begin
  358. PreviewComXML.PreviewRows := 2;
  359. PreviewComXML.PreviewCols := 1;
  360. end
  361. else
  362. begin
  363. PreviewComXML.PreviewRows := 1;
  364. PreviewComXML.PreviewCols := 2;
  365. end;
  366. DisplayCount := TdxBarLargeButton(Sender).Tag;
  367. FbNormal := true;
  368. RepaintCurPagePreview;
  369. end;
  370. procedure TReportsForm.xlbFourPageClick(Sender: TObject);
  371. begin
  372. PreviewComXML.PreviewRows := 2;
  373. PreviewComXML.PreviewCols := 2;
  374. DisplayCount := TdxBarLargeButton(Sender).Tag;
  375. FbNormal := true;
  376. RepaintCurPagePreview;
  377. end;
  378. procedure TReportsForm.xlbFirstPageClick(Sender: TObject);
  379. begin
  380. CurPage := 1;
  381. end;
  382. procedure TReportsForm.SetCurPage(const Value: Integer);
  383. begin
  384. if (Value < 0) or (Value > PageCount) then Exit;
  385. FCurPage := Value;
  386. xcbPages.Text := IntToStr(FCurPage);
  387. //PreviewComXML.FillZero := chkFillZero.Checked;
  388. PreviewReportCurPage;
  389. end;
  390. function TReportsForm.GetPrintEndPage: Integer;
  391. begin
  392. Result := StrToIntDef(xcbEndPage.Text, 0);
  393. end;
  394. function TReportsForm.GetPrintStartPage: Integer;
  395. begin
  396. Result := StrToIntDef(xcbStartPage.Text, 0);
  397. end;
  398. function TReportsForm.GetPageCount: Integer;
  399. begin
  400. Result := PreviewComXML.TotalPages;
  401. end;
  402. function TReportsForm.GetPrecededCount: Integer;
  403. begin
  404. Result := (CurPage + (DisplayCount - 1)) div DisplayCount;
  405. end;
  406. procedure TReportsForm.xlbPrePageClick(Sender: TObject);
  407. begin
  408. if CurPage > 1 then
  409. CurPage := CurPage - 1;
  410. end;
  411. procedure TReportsForm.xlbNextPageClick(Sender: TObject);
  412. begin
  413. if CurPage < PageCount then
  414. CurPage := CurPage + 1;
  415. end;
  416. procedure TReportsForm.xlbLastPageClick(Sender: TObject);
  417. begin
  418. CurPage := PageCount;
  419. end;
  420. procedure TReportsForm.xcbPagesChange(Sender: TObject);
  421. begin
  422. if (StrToIntDef(xcbPages.Text, 0) > 0) and
  423. (StrToIntDef(xcbPages.Text, 0) <= PageCount) then
  424. CurPage := StrToIntDef(xcbPages.Text, 0)
  425. else
  426. xcbPages.Text := IntToStr(CurPage);
  427. end;
  428. procedure TReportsForm.xlbPrintCurPageClick(Sender: TObject);
  429. var
  430. img: TJPEGImage;
  431. begin
  432. if _IsEncrypt or G_IsCloud then
  433. PreviewComXML.Print(PreviewBox.Canvas, CurPage, 1)
  434. else
  435. TipMessage(GetHintStr, Handle);
  436. //PreviewBox.Picture.SaveToFile('E:\Org.bmp');
  437. //ExportReportPage(1, 'E:\Org.jpg', True);
  438. //ExportReportPage(1, 'E:\Cut.jpg', False);
  439. end;
  440. procedure TReportsForm.xcbStartPageChange(Sender: TObject);
  441. begin
  442. if (StrToIntDef(TdxBarCombo(Sender).Text, 0) > 0) and
  443. (StrToIntDef(TdxBarCombo(Sender).Text, 0) <= PageCount) then
  444. TdxBarCombo(Sender).Tag := StrToIntDef(TdxBarCombo(Sender).Text, 0)
  445. else
  446. TdxBarCombo(Sender).Text := IntToStr(TdxBarCombo(Sender).Tag);
  447. end;
  448. procedure TReportsForm.xlbPrintClick(Sender: TObject);
  449. begin
  450. if _IsEncrypt or G_IsCloud then
  451. begin
  452. if extvReport.LeafCheckedCount > 0 then
  453. PrintAllSelectedReports
  454. else
  455. PreviewComXML.PrintMultiPages(PreviewBox.Canvas, PrintStartPage, PrintEndPage);
  456. end
  457. else
  458. TipMessage(GetHintStr, Handle);
  459. end;
  460. procedure TReportsForm.PrintAllSelectedReports;
  461. var
  462. iIndex: Integer;
  463. Node: TExTreeNode;
  464. vTemplateNode: TTemplateNode;
  465. begin
  466. for iIndex := 0 to extvReport.Items.Count - 1 do
  467. begin
  468. Node := extvReport.Items[iIndex];
  469. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  470. vTemplateNode := TTemplateNode(Node.Data);
  471. if FileExists(vTemplateNode.FileName) then
  472. PrintReport(vTemplateNode, False, False, '', '');
  473. end;
  474. extvReport.ClearChecked;
  475. end;
  476. procedure TReportsForm.xlbToPDFClick(Sender: TObject);
  477. var
  478. sFileName: string;
  479. begin
  480. if _IsEncrypt or G_IsCloud then
  481. begin
  482. if extvReport.LeafCheckedCount > 0 then
  483. ExportAllSelectedPDFReports
  484. else
  485. begin
  486. sFileName := PreviewComXML.ReportName + '.pdf';
  487. if SaveFile(sFileName, '.pdf') then
  488. PdfHelper.ExportPages(PreviewComXML, sFileName, PrintStartPage, PrintEndPage);
  489. end;
  490. end
  491. else
  492. TipMessage(GetHintStr, Handle);
  493. end;
  494. procedure TReportsForm.ExportAllSelectedPDFReports;
  495. var
  496. iIndex: Integer;
  497. Node: TExTreeNode;
  498. vTemplateNode: TTemplateNode;
  499. begin
  500. for iIndex := 0 to extvReport.Items.Count - 1 do
  501. begin
  502. Node := extvReport.Items[iIndex];
  503. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  504. vTemplateNode := TTemplateNode(Node.Data);
  505. if FileExists(vTemplateNode.FileName) then
  506. PrintReport(vTemplateNode, True, False,'','');
  507. end;
  508. extvReport.ClearChecked;
  509. end;
  510. procedure TReportsForm.xlbToExcelClick(Sender: TObject);
  511. begin
  512. if _IsEncrypt or G_IsCloud then
  513. begin
  514. if extvReport.LeafCheckedCount > 0 then
  515. ExportAllSelectedXlsReports
  516. else
  517. ExportCurXlsReport;
  518. end
  519. else
  520. TipMessage(GetHintStr, Handle);
  521. end;
  522. procedure TReportsForm.ExportAllSelectedXlsReports;
  523. var
  524. iIndex: Integer;
  525. Node: TExTreeNode;
  526. vTemplateNode: TTemplateNode;
  527. sPath, sOutputFileName: String;
  528. begin
  529. if BrowseFolder(sPath, '请选择导出报表路径', Handle) then
  530. begin
  531. for iIndex := 0 to extvReport.Items.Count - 1 do
  532. begin
  533. Node := extvReport.Items[iIndex];
  534. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  535. vTemplateNode := TTemplateNode(Node.Data);
  536. if IsExcel2010 then
  537. sOutputFileName := sPath + ExtractSimpleFileName(vTemplateNode.FileName) + '.xlsx'
  538. else
  539. sOutputFileName := sPath + ExtractSimpleFileName(vTemplateNode.FileName) + '.xls';
  540. if FileExists(vTemplateNode.FileName) then
  541. PrintReport(vTemplateNode, False, True, sOutputFileName, GetTemplateXlsFileName);
  542. end;
  543. extvReport.ClearChecked;
  544. end;
  545. end;
  546. procedure TReportsForm.ExportCurXlsReport;
  547. var
  548. sFileName: string;
  549. begin
  550. sFileName := extvReport.Selected.Text;
  551. if IsExcel2010 then
  552. begin
  553. if (PrintStartPage <= PrintEndPage) and SaveFile(sFileName, '.xlsx') then
  554. ExportXlsReport(PrintStartPage, PrintEndPage, sFileName, PreviewComXML);
  555. end
  556. else
  557. begin
  558. if (PrintStartPage <= PrintEndPage) and SaveFile(sFileName, '.xls') then
  559. ExportXlsReport(PrintStartPage, PrintEndPage, sFileName, PreviewComXML);
  560. end;
  561. end;
  562. procedure TReportsForm.AfterExport;
  563. begin
  564. // ToDo - 关闭进度条
  565. // ToDo - 取消设置Update进度条事件
  566. // PreviewComXML.OnProgress := nil;
  567. Screen.Cursor := crDefault;
  568. end;
  569. procedure TReportsForm.BeforeExport;
  570. begin
  571. Screen.Cursor := crHourGlass;
  572. // ToDo - 设置Update进度条事件
  573. // PreviewComXML.OnProgress := PreviewComXMLProgress;
  574. // ToDo - 打开进度条
  575. end;
  576. function TReportsForm.GetExcelMode: TOutputExcelMode;
  577. begin
  578. if chkExcelMode.Checked then
  579. Result := oemOneSheet
  580. else
  581. Result := oemNormal;
  582. end;
  583. procedure TReportsForm.extvReportClick(Sender: TObject);
  584. begin
  585. LoadTempletAndDisplay;
  586. end;
  587. procedure TReportsForm.xlbCloseClick(Sender: TObject);
  588. begin
  589. Close;
  590. end;
  591. procedure TReportsForm.AddReportTemplate(ANode: TTemplateNode);
  592. var
  593. vClassNode, vNode: TExTreeNode;
  594. begin
  595. vClassNode := GetClassNode(ANode);
  596. if ANode.SubClassNum <> '' then
  597. vClassNode := GetSubClassNode(vClassNode, ANode);
  598. vNode := extvReport.Items.AddChildObject(vClassNode, ANode.TemplateName, Pointer(ANode));
  599. vNode.ImageIndex := 2;
  600. vNode.SelectedIndex := 3;
  601. vNode.Checked := csUnchecked;
  602. if (vClassNode <> nil) and not vClassNode.Expanded then
  603. vClassNode.Expanded := True;
  604. end;
  605. function TReportsForm.GetClassNode(ANode: TTemplateNode): TExTreeNode;
  606. function FindClassNode(const AName: string): TExTreeNode;
  607. var
  608. I: Integer;
  609. vNode: TExTreeNode;
  610. begin
  611. Result := nil;
  612. for I := 0 to extvReport.Items.Count - 1 do
  613. begin
  614. vNode := extvReport.Items.Item[I];
  615. if SameText(vNode.Text, AName) then
  616. begin
  617. Result := vNode;
  618. Break;
  619. end;
  620. end;
  621. end;
  622. begin
  623. Result := FindClassNode(ANode.ClassNum + '.' + ANode.ClassName);
  624. if not Assigned(Result) then
  625. Result := AddClassNode(nil, ANode.ClassNum + '.' + ANode.ClassName);
  626. end;
  627. procedure TReportsForm.tbImportSrtClick(Sender: TObject);
  628. procedure ImportReportTemplate(const AFileName: string);
  629. var
  630. sNewFileName: string;
  631. vTemplateNode: TTemplateNode;
  632. begin
  633. sNewFileName := GetReportTemplatePath + ExtractFileName(AFileName);
  634. if not FileExists(sNewFileName) then
  635. begin
  636. CopyFileOrFolder(AFileName, sNewFileName);
  637. vTemplateNode := ReportTemplateManager.AddReportTemplate(sNewFileName);
  638. AddReportTemplate(vTemplateNode);
  639. end
  640. else
  641. if QuestMessage('已存在报表模板' + ExtractFileName(AFileName) + ',是否覆盖原模板?', Handle) then
  642. begin
  643. CopyFileOrFolder(AFileName, sNewFileName);
  644. vTemplateNode := ReportTemplateManager.FindTemplate(sNewFileName);
  645. if Assigned(vTemplateNode) then
  646. vTemplateNode.RefreshTemplateProperties;
  647. end
  648. else
  649. Exit;
  650. end;
  651. var
  652. sgsFiles: TStrings;
  653. iFile: Integer;
  654. begin
  655. sgsFiles := TStringList.Create;
  656. try
  657. if SelectFiles(sgsFiles, '.srt') then
  658. begin
  659. for iFile := 0 to sgsFiles.Count - 1 do
  660. ImportReportTemplate(sgsFiles.Strings[iFile]);
  661. end;
  662. finally
  663. sgsFiles.Free;
  664. end;
  665. end;
  666. procedure TReportsForm.tbDeleteSrtClick(Sender: TObject);
  667. var
  668. vTemplateNode: TTemplateNode;
  669. begin
  670. if not Assigned(extvReport.Selected) then Exit;
  671. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  672. if not Assigned(vTemplateNode) then Exit;
  673. extvReport.Items.Delete(extvReport.Selected);
  674. DeleteFile(vTemplateNode.FileName);
  675. ReportTemplateManager.DeleteReportTemplate(vTemplateNode);
  676. LoadTempletAndDisplay;
  677. end;
  678. procedure TReportsForm.tbExportSrtClick(Sender: TObject);
  679. var
  680. vTemplateNode: TTemplateNode;
  681. sFileName: string;
  682. begin
  683. if not Assigned(extvReport.Selected) then Exit;
  684. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  685. if not Assigned(vTemplateNode) then Exit;
  686. sFileName := vTemplateNode.TemplateName;
  687. if SaveFile(sFileName, '.srt') then
  688. begin
  689. if not FileExists(sFileName) or QuestMessage('存在同名文件,是否覆盖?', Handle) then
  690. CopyFileOrFolder(vTemplateNode.FileName, sFileName);
  691. end;
  692. end;
  693. procedure TReportsForm.PreviewComXMLContentDisplay(
  694. var contentFontRec: TFontRec; dataType: Integer; isReading: Boolean;
  695. DrawType: Integer; isPrinting: Boolean);
  696. begin
  697. if ReportConfig.ContentIsNarrow then
  698. begin
  699. if (isReading) then
  700. begin
  701. begin
  702. contentFontRec.FontName := 'Arial Narrow';
  703. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  704. end;
  705. end else
  706. begin
  707. if (DrawType = DRAW_TYPE_EXCEL_XML) or (DrawType = DRAW_TYPE_EXCEL) or (DrawType = DRAW_TYPE_EXCEL_OE) then
  708. begin
  709. if (dataType <> DATA_TYPE_DOUBLE) and (dataType <> DATA_TYPE_FLOAT) then
  710. begin
  711. contentFontRec.FontName := ReportConfig.ContentFont.Name;
  712. end;
  713. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  714. end else if (isPrinting) then
  715. begin
  716. if (dataType = DATA_TYPE_DOUBLE) or (dataType = DATA_TYPE_FLOAT) then
  717. begin
  718. contentFontRec.FontName := 'Arial Narrow';
  719. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 7 div 6;
  720. end else
  721. begin
  722. contentFontRec.FontName := ReportConfig.ContentFont.Name;
  723. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  724. end;
  725. end else
  726. begin
  727. if (dataType = DATA_TYPE_DOUBLE) or (dataType = DATA_TYPE_FLOAT) then
  728. begin
  729. contentFontRec.FontName := 'Arial Narrow';
  730. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  731. end else
  732. begin
  733. contentFontRec.FontName := ReportConfig.ContentFont.Name;
  734. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  735. end;
  736. end;
  737. end;
  738. end;
  739. end;
  740. procedure TReportsForm.xlbSetupClick(Sender: TObject);
  741. begin
  742. if AdjustReport then
  743. LoadTempletAndDisplay;
  744. end;
  745. procedure TReportsForm.InitReportSettings(APrintCom: TPrintComXML; ATemplate: TTemplateNode);
  746. begin
  747. APrintCom.FillZero := chkFillZero.Checked;
  748. InitPageSettings(APrintCom);
  749. InitPaperSettings(ATemplate, APrintCom);
  750. {APrintCom.ShowBackgroundMark := FProjectData.ProjProperties.ShowReportShading;
  751. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShading;}
  752. if FProjectData.ProjProperties.ReportShowState then
  753. begin
  754. if FProjectData.ProjProperties.ReportShowStateWithoutReply and
  755. ((FProjectData.ProjProperties.AuditStatus = -1) or (FProjectData.PhaseIndex < FProjectData.ProjProperties.PhaseCount)) then
  756. APrintCom.ShowBackgroundMark := False
  757. else
  758. APrintCom.ShowBackgroundMark := True;
  759. end
  760. else
  761. APrintCom.ShowBackgroundMark := False;
  762. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShowStateText;
  763. end;
  764. procedure TReportsForm.InitPageSettings(APrintCom: TPrintComXML);
  765. begin
  766. // 设置页面大小
  767. APrintCom.setPageSize(ReportConfig.PageSize);
  768. if ReportConfig.PageSize = 'A3' then
  769. APrintCom.PrintPageSizeIdx := DMPAPER_A3
  770. else if ReportConfig.PageSize = 'A4' then
  771. APrintCom.PrintPageSizeIdx := DMPAPER_A4;
  772. // 设置边距
  773. APrintCom.setEdge(0, '', ReportConfig.LeftEdge/10);
  774. APrintCom.setEdge(1, '', ReportConfig.RightEdge/10);
  775. APrintCom.setEdge(2, '', ReportConfig.UpEdge/10);
  776. APrintCom.setEdge(3, '', ReportConfig.DownEdge/10);
  777. end;
  778. procedure TReportsForm.InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  779. procedure InitRepBorderLine;
  780. var
  781. i: Integer;
  782. ObjList : TList;
  783. ShapeRec : PPicRec;
  784. begin
  785. ObjList := TList.Create;
  786. try
  787. APrintCom.getAllShapeObjs(1, ObjList);
  788. for i := 0 to ObjList.Count - 1 do
  789. begin
  790. ShapeRec := ObjList[i];
  791. // 设置报表边框线粗
  792. ShapeRec.PenWidth := ReportConfig.BorderLine;
  793. // 设置是否绘制报表边框横线
  794. if (ShapeRec.ExArea.ExLeft <> ShapeRec.ExArea.ExRight) then
  795. begin
  796. if not ReportConfig.RepBorderUnderLine then
  797. ShapeRec.PenStyle := integer(psClear)
  798. else
  799. ShapeRec.PenStyle := integer(psSolid);
  800. end;
  801. // 设置是否绘制报表边框竖线
  802. if (ShapeRec.ExArea.ExTop <> ShapeRec.ExArea.ExBottom) and
  803. ((ShapeRec.ExArea.ExLeft = 0) or (ShapeRec.ExArea.ExLeft = 100)) then
  804. begin //这里的判断条件是约定好的
  805. if not ReportConfig.RepBorderVerLine then
  806. ShapeRec.PenStyle := integer(psClear)
  807. else
  808. ShapeRec.PenStyle := integer(psSolid)
  809. end;
  810. APrintCom.setShapeObj(ShapeRec);
  811. end;
  812. finally
  813. ObjList.Free;
  814. end;
  815. end;
  816. procedure InitRepCellLine;
  817. var
  818. i: Integer;
  819. ObjList : TList;
  820. ColumnRec : PColumnRec;
  821. FlowContentRec : PContentRec;
  822. CrossContentRec : PCrossContentRec;
  823. begin
  824. ObjList := TList.Create;
  825. try
  826. APrintCom.getAllFlowShowContentObjs(ObjList);
  827. // 设置报表表格横线
  828. for i := 0 to ObjList.Count - 1 do
  829. begin
  830. FlowContentRec := ObjList[i];
  831. FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  832. FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  833. APrintCom.setFlowContentObj(FlowContentRec);
  834. end;
  835. APrintCom.getAllCrossContentObjs(ObjList);
  836. for i := 0 to ObjList.Count - 1 do
  837. begin
  838. CrossContentRec := ObjList[i];
  839. CrossContentRec.CrossContent.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  840. CrossContentRec.CrossContent.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  841. APrintCom.setCrossContentObj(CrossContentRec);
  842. end;
  843. // 设置报表表格竖线
  844. APrintCom.getAllFlowShowContentObjs(ObjList);
  845. for i := 0 to ObjList.Count - 1 do
  846. begin
  847. FlowContentRec := ObjList[i];
  848. FlowContentRec.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  849. FlowContentRec.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  850. // 如果设置无表格边框线,则两端的表格竖线线粗为0
  851. if (not ReportConfig.RepBorderVerLine) then
  852. if (i = 0) then
  853. FlowContentRec.LineInfo.LeftThick := 0
  854. else if (i = ObjList.Count - 1) then
  855. FlowContentRec.LineInfo.RightThick := 0;
  856. APrintCom.setFlowContentObj(FlowContentRec);
  857. end;
  858. APrintCom.getAllCrossContentObjs(ObjList);
  859. for i := 0 to ObjList.Count - 1 do
  860. begin
  861. CrossContentRec := ObjList[i];
  862. CrossContentRec.CrossContent.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  863. CrossContentRec.CrossContent.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  864. ColumnRec := CrossContentRec.CrossContent.Column;
  865. //这里还要判断如果没有边框竖线的情况下,表格竖线边缘的线粗也为0
  866. //前提是所属表栏最右位置位于边缘
  867. if (not ReportConfig.RepBorderVerLine) and (ColumnRec<>nil) and
  868. ((ColumnRec.ExArea.ExRight = 100.0) or (ColumnRec.ExArea.ExLeft = 0.0)) then
  869. begin
  870. case CrossContentRec.CrossType of
  871. 0 : //交叉行
  872. begin
  873. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  874. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  875. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  876. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  877. end;
  878. 1 : //交叉列
  879. begin
  880. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  881. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  882. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  883. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  884. //(*
  885. if (CrossContentRec.CrossContent.isSpecialBorder) then
  886. begin
  887. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  888. CrossContentRec.CrossContent.SpecialLineInfo.RightThick := 0;
  889. end;
  890. //*)
  891. end;
  892. 2 : //显示数据
  893. begin
  894. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  895. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  896. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  897. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  898. end;
  899. 3 : //固定LABEL
  900. begin
  901. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  902. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  903. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  904. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  905. end;
  906. 4 : //序号
  907. begin
  908. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  909. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  910. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  911. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  912. end;
  913. 5 : //横向统计
  914. begin
  915. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  916. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  917. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  918. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  919. end;
  920. end;
  921. end;
  922. APrintCom.setCrossContentObj(CrossContentRec);
  923. end;
  924. finally
  925. ObjList.Free;
  926. end;
  927. end;
  928. procedure InitOtherArea;
  929. procedure SetPTRBorder(PTR : PTextRec);
  930. procedure SetLeftRightBorder;
  931. begin
  932. if PTR.ExArea.ExLeft = 0.0 then
  933. begin
  934. if BorderWidth = 0.0 then
  935. PTR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth;
  936. end;
  937. if PTR.ExArea.ExRight = 100.0 then
  938. begin
  939. if BorderWidth = 0.0 then
  940. PTR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth
  941. end;
  942. end;
  943. procedure SetHorLine;
  944. begin
  945. if (PTR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  946. PTR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  947. if (PTR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  948. PTR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  949. end;
  950. begin
  951. SetLeftRightBorder;
  952. SetHorLine;
  953. end;
  954. procedure SetPCRBorder(PCR : PColumnRec);
  955. procedure SetLeftRightBorder;
  956. begin
  957. if PCR.ExArea.ExLeft = 0.0 then
  958. begin
  959. if BorderWidth = 0.0 then
  960. PCR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth
  961. end;
  962. if PCR.ExArea.ExRight = 100.0 then
  963. begin
  964. if BorderWidth = 0.0 then
  965. PCR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth;
  966. end;
  967. end;
  968. procedure SetVerLine;
  969. begin
  970. if PCR.ExArea.ExLeft = 0.0 then
  971. PCR.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  972. if PCR.ExArea.ExRight = 100.0 then
  973. PCR.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  974. end;
  975. procedure SetHorLine;
  976. begin
  977. if (PCR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  978. PCR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  979. if (PCR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  980. PCR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  981. end;
  982. begin
  983. SetLeftRightBorder;
  984. SetVerLine;
  985. SetHorLine;
  986. end;
  987. var i,k : integer;
  988. ObjList : TList;
  989. ActAreaRec : PActiveAreaRec;
  990. PSR : PShowElementRec;
  991. begin
  992. ObjList := TList.Create;
  993. try
  994. ActAreaRec := nil;
  995. PreviewComXML.getAllActAreaObjs(ObjList);
  996. for i := 0 to ObjList.Count - 1 do
  997. begin
  998. ActAreaRec := ObjList[i];
  999. if (ActAreaRec.ShowType < 0) or (ActAreaRec.ShowType > 2) then Continue;
  1000. if not Assigned(ActAreaRec.ElementList) then Continue;
  1001. for k := 0 to ActAreaRec.ElementList.Count - 1 do
  1002. begin
  1003. PSR := PShowElementRec(ActAreaRec.ElementList[k]);
  1004. case PSR.ElementType of
  1005. 0..2 : SetPTRBorder(PSR.Data); //文本,参数,字段,表栏
  1006. 7 : SetPCRBorder(PSR.Data) //Column
  1007. end;
  1008. APrintCom.setActShowElementObj(PSR);
  1009. end;
  1010. end;
  1011. finally
  1012. ObjList.Free;
  1013. end;
  1014. end;
  1015. begin
  1016. if not Assigned(ATemplate) or (ATemplate.SelfFormat = 0) then
  1017. begin
  1018. InitFont(APrintCom); // 各类字体
  1019. InitRepBorderLine; // 报表边框
  1020. InitRepCellLine; // 报表表格
  1021. InitOtherArea; // 活动区域
  1022. end;
  1023. end;
  1024. procedure TReportsForm.PreviewComXMLCrossTabLabelShow(valIDX: Integer;
  1025. var ExLeft, ExRight: Double; var isShow: Boolean;
  1026. CrsTabShowType: Integer);
  1027. var field : PFieldRec;
  1028. begin
  1029. if (CrsTabShowType = -1) then exit;
  1030. field := PreviewComXML.getFieldByID(6);
  1031. if (field <> nil) then
  1032. begin
  1033. if (field.DataLen > valIDX) and (valIDX >= 0) then
  1034. begin
  1035. if (field.Value[valIDX] = 1.5) then
  1036. begin
  1037. case CrsTabShowType of
  1038. 1 : begin
  1039. isShow := false;
  1040. end;
  1041. 2 : begin
  1042. ExLeft := 0;
  1043. ExRight := 100;
  1044. end;
  1045. 3 : begin
  1046. //
  1047. end
  1048. else
  1049. begin
  1050. //
  1051. end;
  1052. end;
  1053. end;
  1054. end;
  1055. end;
  1056. end;
  1057. procedure TReportsForm.rdbtnA4Click(Sender: TObject);
  1058. begin
  1059. ReportConfig.PageSize := TRadioButton(Sender).Caption;
  1060. SetPrinterPageSize(ReportConfig.PageSize);
  1061. LoadTempletAndDisplay;
  1062. end;
  1063. procedure TReportsForm.chkFillZeroClick(Sender: TObject);
  1064. begin
  1065. PreviewComXML.FillZero := chkFillZero.Checked;
  1066. PreviewReportCurPage;
  1067. end;
  1068. procedure TReportsForm.InitFont(APrintCom: TPrintComXML);
  1069. procedure AssignFontRec(AFontRec: TFontRec; AFont: TFont);
  1070. begin
  1071. AFontRec.FontName := AFont.Name;
  1072. AFontRec.FontHeight := Round(AFont.Size*4/3) ;
  1073. AFontRec.FontBold := 400 + Integer(fsBold in AFont.Style)*200;
  1074. AFontRec.FontItalic := Integer(fsItalic in AFont.Style);
  1075. AFontRec.FontUnderLine := Integer(fsUnderLine in AFont.Style);
  1076. end;
  1077. procedure InitTitleFont;
  1078. var
  1079. TitleRec : PTitleRec;
  1080. begin
  1081. TitleRec := PreviewComXML.getTitleByID(1);
  1082. if TitleRec <> nil then
  1083. begin
  1084. AssignFontRec(TitleRec.FontRec, ReportConfig.TitleFont);
  1085. APrintCom.setTitleObj(TitleRec);
  1086. end;
  1087. end;
  1088. procedure InitColumnFont;
  1089. procedure InitColumnThick(AColumnRec: PColumnRec);
  1090. begin
  1091. if (ReportConfig.ReportCellLine > 0.2) then
  1092. begin
  1093. if (AColumnRec.LineInfo.LeftThick > 0.2) then
  1094. AColumnRec.LineInfo.LeftThick := ReportConfig.ReportCellLine;
  1095. if (AColumnRec.LineInfo.RightThick > 0.2) then
  1096. AColumnRec.LineInfo.RightThick := ReportConfig.ReportCellLine;
  1097. if (AColumnRec.LineInfo.TopThick > 0.2) then
  1098. AColumnRec.LineInfo.TopThick := ReportConfig.ReportCellLine;
  1099. if (AColumnRec.LineInfo.BottomThick > 0.2) then
  1100. AColumnRec.LineInfo.BottomThick := ReportConfig.ReportCellLine;
  1101. end;
  1102. end;
  1103. var
  1104. i, j: Integer;
  1105. ObjList: TList;
  1106. ColumnRec : PColumnRec;
  1107. AAR : PActiveAreaRec;
  1108. SER : PShowElementRec;
  1109. begin
  1110. ObjList := TList.Create;
  1111. try
  1112. APrintCom.getAllColumnHeadObjs(ObjList);
  1113. for i := 0 to ObjList.Count - 1 do
  1114. begin
  1115. ColumnRec := ObjList[i];
  1116. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1117. InitColumnThick(ColumnRec);
  1118. APrintCom.setColumnHeadTailObj(0, ColumnRec);
  1119. end;
  1120. APrintCom.getAllColumnTailObjs(ObjList);
  1121. for i := 0 to ObjList.Count - 1 do
  1122. begin
  1123. ColumnRec := ObjList[i];
  1124. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1125. InitColumnThick(ColumnRec);
  1126. APrintCom.setColumnHeadTailObj(1,ColumnRec);
  1127. end;
  1128. APrintCom.getAllActAreaObjs(ObjList);
  1129. for i := 0 to ObjList.Count - 1 do
  1130. begin
  1131. AAR := ObjList[i];
  1132. for j := 0 to AAR.ElementList.Count - 1 do
  1133. begin
  1134. SER := AAR.ElementList[j];
  1135. if (SER.ElementType = 7) then
  1136. begin
  1137. ColumnRec := SER.Data;
  1138. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1139. InitColumnThick(ColumnRec);
  1140. APrintCom.setActShowElementObj(SER);
  1141. end;
  1142. end;
  1143. end;
  1144. finally
  1145. ObjList.Free;
  1146. end;
  1147. end;
  1148. procedure InitContentAndGatherFont;
  1149. var
  1150. i, j: Integer;
  1151. ObjList: TList;
  1152. FlowContentRec : PContentRec;
  1153. CrossContentRec : PCrossContentRec;
  1154. SumRec : PSumRec;
  1155. begin
  1156. ObjList := TList.Create;
  1157. try
  1158. // 设置表正文
  1159. APrintCom.getAllFlowShowContentObjs(ObjList);
  1160. for i := 0 to ObjList.Count - 1 do
  1161. begin
  1162. FlowContentRec := ObjList[i];
  1163. if not (FlowContentRec.Fixed) then
  1164. begin
  1165. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1166. APrintCom.setFlowContentObj(FlowContentRec);
  1167. end;
  1168. end;
  1169. APrintCom.getAllBillShowContentObjs(ObjList);
  1170. for i := 0 to ObjList.Count - 1 do
  1171. begin
  1172. FlowContentRec := ObjList[i];
  1173. if not(FlowContentRec.Fixed) then
  1174. begin
  1175. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1176. APrintCom.setBillContentObj(FlowContentRec);
  1177. end;
  1178. end;
  1179. APrintCom.getAllCrossContentObjs(ObjList);
  1180. for i := 0 to ObjList.Count - 1 do
  1181. begin
  1182. CrossContentRec := ObjList[i];
  1183. if not(CrossContentRec.CrossContent.Fixed) then
  1184. begin
  1185. AssignFontRec(CrossContentRec.CrossContent.FontRec, ReportConfig.ContentFont);
  1186. APrintCom.setCrossContentObj(CrossContentRec);
  1187. end;
  1188. end;
  1189. // 设置表合计
  1190. for i := 0 to 2 do
  1191. begin
  1192. APrintCom.getAllSumObjs(i,ObjList);
  1193. for j := 0 to ObjList.Count - 1 do
  1194. begin
  1195. SumRec := ObjList[j];
  1196. AssignFontRec(SumRec.FontRec, ReportConfig.GatherFont);
  1197. APrintCom.setSumObj(SumRec);
  1198. end;
  1199. end;
  1200. finally
  1201. ObjList.Free;
  1202. end;
  1203. end;
  1204. procedure InitGridHeaderFont;
  1205. var
  1206. i: Integer;
  1207. ObjList: TList;
  1208. HeadTailRec : PHeadRec;
  1209. begin
  1210. ObjList := TList.Create;
  1211. try
  1212. APrintCom.getAllHeadObjs(ObjList);
  1213. for i := 0 to ObjList.Count - 1 do
  1214. begin
  1215. HeadTailRec := ObjList[i];
  1216. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1217. APrintCom.setHeadTailObj(0, HeadTailRec);
  1218. end;
  1219. APrintCom.getAllTailObjs(ObjList);
  1220. for i := 0 to ObjList.Count - 1 do
  1221. begin
  1222. HeadTailRec := ObjList[i];
  1223. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1224. APrintCom.setHeadTailObj(1, HeadTailRec);
  1225. end;
  1226. finally
  1227. ObjList.Free;
  1228. end;
  1229. end;
  1230. begin
  1231. InitTitleFont;
  1232. InitColumnFont;
  1233. InitContentAndGatherFont;
  1234. InitGridHeaderFont;
  1235. end;
  1236. procedure TReportsForm.PreviewComXMLGetDatasetEvent(
  1237. DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet);
  1238. begin
  1239. if DatasetInfo.ID = 0 then
  1240. ADataSet := MemoryReportManager.GetSqlResultDataSet(ReportTemplateManager.Current.InteractInfo.Sql, FProjectData)
  1241. else
  1242. ADataset := MemoryReportManager.GetMemoryDataSet(DatasetInfo.ID, FProjectData);
  1243. end;
  1244. function TReportsForm.GetIsExcel2010: Boolean;
  1245. begin
  1246. Result := chkExcel2010.Checked;
  1247. end;
  1248. procedure TReportsForm.InitFormView;
  1249. begin
  1250. rdbtnA3.Checked := SameText(rdbtnA3.Caption, ReportConfig.PageSize);
  1251. rdbtnA4.Checked := SameText(rdbtnA4.Caption, ReportConfig.PageSize);
  1252. SetPrinterPageSize(ReportConfig.PageSize);
  1253. pnlSearch.Visible := _IsDebugView;
  1254. if G_IsCloud then
  1255. begin
  1256. btnRMgr.Visible := True;
  1257. tbImportSrt.Visible := False;
  1258. end
  1259. else
  1260. begin
  1261. btnRMgr.Visible := False;
  1262. tbImportSrt.Visible := True;
  1263. end;
  1264. end;
  1265. procedure TReportsForm.LoadExcelBorder(var Border: TColumnLineRec);
  1266. begin
  1267. Border.LeftThick := 0.5;
  1268. Border.TopThick := 0.5;
  1269. Border.RightThick := 0.5;
  1270. Border.BottomThick := 0.5;
  1271. if not ReportConfig.RepBorderVerLine then
  1272. begin
  1273. Border.LeftThick := 0;
  1274. Border.RightThick := 0;
  1275. end;
  1276. end;
  1277. procedure TReportsForm.PrintReport(ATemplateNode: TTemplateNode;
  1278. isPDF, isExcel: boolean; ExcelOutputName, TemplateFileName: string);
  1279. function CheckPrinterReady: Boolean;
  1280. var
  1281. PrinterHD: THandle;
  1282. NoJobs: Word;
  1283. s: LongWord;
  1284. Job_Info: Array[0..10] of Job_INFO_1;
  1285. cbNeeded: Cardinal;
  1286. cReturned: Cardinal;
  1287. ret: LongBool;
  1288. begin
  1289. if OpenPrinter(PChar(Printer.Printers[Printer.PrinterIndex]), PrinterHD, 0) then
  1290. begin
  1291. s := SizeOf(Job_Info);
  1292. cbNeeded := 0;
  1293. cReturned := 0;
  1294. NoJobs := 10;
  1295. ret := ENumJobs(PrinterHD, 0, NoJobs, 1, @Job_Info, s, cbNeeded, cReturned);
  1296. Result := not((cReturned > 0) and (Job_Info[0].TotalPages > 0));
  1297. end
  1298. else
  1299. Result := True;
  1300. end;
  1301. procedure PrintTemplet;
  1302. var
  1303. sFileName: string;
  1304. begin
  1305. if isPDF then
  1306. begin
  1307. sFileName := BatchPrintXml.ReportName + '.pdf';
  1308. if SaveFile(sFileName, '.pdf') then
  1309. PdfHelper.ExportAllPages(BatchPrintXml, sFileName);
  1310. (*
  1311. BatchPrintXml.PrintPDFAll(PreviewBox.Canvas);
  1312. while not CheckPrinterReady do
  1313. Sleep(1000);
  1314. *)
  1315. end
  1316. else if not isExcel then
  1317. BatchPrintXml.PrintAll(PreviewBox.Canvas, 1)
  1318. else
  1319. ExportXlsReport(1, BatchPrintXml.TotalPages, ExcelOutputName, BatchPrintXml);
  1320. end;
  1321. var
  1322. strRptName : string;
  1323. begin
  1324. if not FileExists(ATemplateNode.FileName) then Exit;
  1325. ClearReportOprList;
  1326. ClearReportFuncList;
  1327. Screen.Cursor := crHourGlass;
  1328. try
  1329. LoadTemplet(ATemplateNode, BatchPrintXml);
  1330. if BatchPrintXml.TotalPages > 0 then
  1331. PrintTemplet
  1332. {else if strRptName <> '' then
  1333. begin
  1334. LoadTemplet(RptArchiverObj, strRptName);
  1335. PrintEmptyTemplet;
  1336. end;}
  1337. finally
  1338. Screen.Cursor := crDefault;
  1339. end;
  1340. end;
  1341. function TReportsForm.GetSysTempDirectory : String;
  1342. var TempDir : array[0..255] of Char;
  1343. begin
  1344. GetTempPath(255, @TempDir);
  1345. Result := StrPas(TempDir);
  1346. end;
  1347. procedure TReportsForm.ExportXlsReport(AStartPage, AEndPage: Integer;
  1348. const AFileName: string; APrintCom: TPrintComXML);
  1349. procedure ExportPagesXlsReport(AStartPage, AEndPage: Integer; const AFileName: string);
  1350. var
  1351. Border : TColumnLineRec;
  1352. themeFile, tmpPath : string;
  1353. begin
  1354. LoadExcelBorder(Border);
  1355. if IsExcel2010 then
  1356. begin
  1357. (*
  1358. APrintCom.OutputToExcelFileOE(PreviewBox.Canvas, AStartPage, AEndPage, AFileName, ExcelMode, Border, nil)
  1359. (*)
  1360. //用新方法处理
  1361. themeFile := ExtractFilePath(Application.ExeName) + 'Data\theme1.xml';
  1362. tmpPath := GetSysTempDirectory;
  1363. APrintCom.buildOutputData(PreviewBox.Canvas, AStartPage, AEndPage, Border);
  1364. ExcelOutput.outputAsExcel(APrintCom.OutputData, APrintCom.PageSize, (excelMode = oemOneSheet), tmpPath, themeFile, AFileName, nil);
  1365. //*)
  1366. end else
  1367. begin
  1368. //APrintCom.OutputToExcelFile(PreviewBox.Canvas, AStartPage, AEndPage, GetTemplateXlsFileName, AFileName, ExcelMode, Border);
  1369. APrintCom.OutputToExcelFileOE(PreviewBox.Canvas, AStartPage, AEndPage, AFileName, ExcelMode, Border, nil);
  1370. //现2010格式与之前格式应用同一控件导出
  1371. end;
  1372. end;
  1373. var
  1374. iStartPage, iEndPage, iCount: Integer;
  1375. sFileName: string;
  1376. begin
  1377. BeforeExport;
  1378. try
  1379. if (ExcelMode = oemNormal) and (PrintEndPage - PrintStartPage > 30) then
  1380. begin
  1381. iStartPage := PrintStartPage;
  1382. iEndPage := iStartPage + 19;
  1383. iCount := 1;
  1384. repeat
  1385. begin
  1386. if IsExcel2010 then
  1387. sFileName := Format('%s[%d].xlsx', [ExtractSimpleFileName(AFileName), iCount])
  1388. else
  1389. sFileName := Format('%s[%d].xls', [ExtractSimpleFileName(AFileName), iCount]);
  1390. ExportPagesXlsReport(iStartPage, iEndPage, sFileName);
  1391. iStartPage := iStartPage + 20;
  1392. iEndPage := Min(iEndPage + 20, PrintEndPage);
  1393. Inc(iCount);
  1394. end
  1395. until iStartPage > iEndPage;
  1396. end
  1397. else
  1398. ExportPagesXlsReport(AStartPage, AEndPage, AFileName);
  1399. finally
  1400. AfterExport;
  1401. end;
  1402. end;
  1403. procedure TReportsForm.LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  1404. var
  1405. RptArchiverObj: TReportArchiver;
  1406. Mem: TMemoryStream;
  1407. begin
  1408. RptArchiverObj := TReportArchiver.Create;
  1409. if ATemplate.IsMulti then
  1410. RptArchiverObj.FileName := ATemplate.MultiFileNames[FProjectData.PhaseIndex]
  1411. else
  1412. RptArchiverObj.FileName := ATemplate.FileName;
  1413. Mem := RptArchiverObj.Extract;
  1414. try
  1415. // 以下代码有顺序限制,不可修改,主要保证在不修改报表模板文件的基础上可以用户定制报表格式
  1416. // 私以为,原因在于这些设置修改后,并不能生效,需要保存再读取方可生效
  1417. // 读取报表模板
  1418. if not APrintCom.ReadReportStream(Mem) then Exit;
  1419. // 将报表设置中的数据覆盖掉原模板的数据
  1420. InitReportSettings(APrintCom, ATemplate);
  1421. // 保存
  1422. APrintCom.SaveToStream(Mem);
  1423. // 再次读取,使报表设置中的设置生效
  1424. APrintCom.ReadReportStream(Mem);
  1425. // ReadReportStream之后会将PreviewComXML的FillZero值赋为True,故再赋值一次
  1426. APrintCom.FillZero := chkFillZero.Checked;
  1427. InitPageSettings(APrintCom);
  1428. APrintCom.ReadDBData;
  1429. //设置好字体,否则Canvas的默认字体在计算自动行高的时候会出现偏差
  1430. PreviewBox.Canvas.Font.Name := ReportConfig.ContentFont.Name;
  1431. PreviewBox.Canvas.Font.Size := ReportConfig.ContentFont.Size;
  1432. APrintCom.AnalyseData(PreviewBox.Canvas);
  1433. finally
  1434. if Mem <> nil then
  1435. Mem.Free;
  1436. RptArchiverObj.Free;
  1437. end;
  1438. end;
  1439. function TReportsForm.GetHintStr: string;
  1440. begin
  1441. Result := #13#10 +
  1442. '对不起,学习版不提供报表打印、导出功能。'#13#10 +
  1443. #13#10 +
  1444. '以下为收费服务项目,请在必要时联系纵横:'#13#10 +
  1445. #13#10 +
  1446. '企业QQ:800003850 客服热线:(0756)3850888';
  1447. end;
  1448. function TReportsForm.GetSubClassNode(AClassNode: TExTreeNode;
  1449. ANode: TTemplateNode): TExTreeNode;
  1450. function FindNode(AParent: TExTreeNode; const AName: string): TExTreeNode;
  1451. var
  1452. I: Integer;
  1453. vNode: TExTreeNode;
  1454. begin
  1455. Result := nil;
  1456. if Assigned(AParent) then
  1457. vNode := AParent.getFirstChild
  1458. else
  1459. vNode := extvReport.Items.GetFirstNode;
  1460. while not Assigned(Result) and Assigned(vNode) do
  1461. begin
  1462. if SameText(vNode.Text, AName) then
  1463. Result := vNode;
  1464. vNode := vNode.getNextSibling;
  1465. end;
  1466. end;
  1467. begin
  1468. Result := FindNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1469. if not Assigned(Result) then
  1470. Result := AddClassNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1471. end;
  1472. function TReportsForm.AddClassNode(AParent: TExTreeNode;
  1473. const AName: string): TExTreeNode;
  1474. begin
  1475. Result := extvReport.Items.AddChildObject(AParent, AName, Pointer(nil));
  1476. Result.ImageIndex := 0;
  1477. Result.SelectedIndex := 1;
  1478. Result.Checked := csUnchecked;
  1479. Result.Expanded := True;
  1480. end;
  1481. procedure TReportsForm.SaveReportInteractData(ATemplate: TTemplateNode);
  1482. begin
  1483. case ATemplate.InteractFlag of
  1484. 1: SaveAuditOpinion(ATemplate);
  1485. end;
  1486. end;
  1487. procedure TReportsForm.SaveAuditOpinion(ATemplate: TTemplateNode);
  1488. var
  1489. SelectForm: TAuditSelctForm;
  1490. begin
  1491. SelectForm := TAuditSelctForm.Create(FProjectData, ATemplate);
  1492. try
  1493. if SelectForm.ShowModal = mrOk then
  1494. SelectForm.SaveAuditData;
  1495. finally
  1496. SelectForm.Free;
  1497. end;
  1498. end;
  1499. destructor TReportsForm.Destroy;
  1500. begin
  1501. FReportCon.Free;
  1502. FReportDataPrepare.Free;
  1503. inherited;
  1504. end;
  1505. // 启用报表模板管理器,报表导入功能取消。
  1506. procedure TReportsForm.btnRMgrClick(Sender: TObject);
  1507. var vRMForm: TReportManagerForm;
  1508. begin
  1509. Screen.Cursor := crHourGlass;
  1510. vRMForm := TReportManagerForm.Create(nil);
  1511. vRMForm.ReportsForm := Self;
  1512. try
  1513. vRMForm.ShowModal;
  1514. finally
  1515. vRMForm.Free;
  1516. Screen.Cursor := crDefault;
  1517. end;
  1518. end;
  1519. procedure TReportsForm.RefreshReportTemplets;
  1520. begin
  1521. ReportTemplateManager.RefreshTemplates;
  1522. LoadReportTemplets;
  1523. LoadTempletAndDisplay;
  1524. end;
  1525. procedure TReportsForm.FormActivate(Sender: TObject);
  1526. var vReports: TReports;
  1527. begin
  1528. // 自动检测并提醒用户有新报表要更新
  1529. if G_IsCloud then
  1530. begin
  1531. vReports := TReports.Create(nil);
  1532. try
  1533. if vReports.HasNeedUpdateReport then
  1534. begin
  1535. Application.MessageBox('系统检测到有新的报表可以更新!', '提示', MB_OK + MB_ICONINFORMATION);
  1536. btnRMgr.Click;
  1537. end;
  1538. finally
  1539. vReports.Free;
  1540. end;
  1541. end;
  1542. end;
  1543. procedure TReportsForm.imgSearchClick(Sender: TObject);
  1544. function SearchAfter(const AText: string; vBegin: TExTreeNode): TExTreeNode;
  1545. var
  1546. vNext: TExTreeNode;
  1547. begin
  1548. Result := nil;
  1549. vNext := vBegin.GetNext;
  1550. while Assigned(vNext) and not Assigned(Result) do
  1551. begin
  1552. if (Pos(AText, vNext.Text) > 0) then
  1553. Result := vNext;
  1554. vNext := vNext.GetNext;
  1555. end;
  1556. end;
  1557. function SearchBegin(const AText: string; vEnd: TExTreeNode): TExTreeNode;
  1558. var
  1559. vPre: TExTreeNode;
  1560. begin
  1561. Result := nil;
  1562. vPre := extvReport.Items.GetFirstNode;
  1563. while (vPre <> vEnd) and not Assigned(Result) do
  1564. begin
  1565. if (Pos(AText, vPre.Text) > 0) then
  1566. Result := vPre;
  1567. vPre := vPre.GetNext;
  1568. end;
  1569. end;
  1570. procedure SearchReportTemplate(const AText: string);
  1571. var
  1572. vNode: TExTreeNode;
  1573. begin
  1574. vNode := SearchAfter(AText, extvReport.Selected);
  1575. if not Assigned(vNode) then
  1576. vNode := SearchBegin(AText, extvReport.Selected);
  1577. if Assigned(vNode) then
  1578. begin
  1579. extvReport.Selected := vNode;
  1580. extvReport.OnClick(extvReport);
  1581. end
  1582. else
  1583. WarningMessage(Format('未找到含关键字“%s”的报表,请缩短关键字后查询', [AText]));
  1584. end;
  1585. begin
  1586. SearchReportTemplate(edtSearch.Text);
  1587. end;
  1588. procedure TReportsForm.extvReportKeyDown(Sender: TObject; var Key: Word;
  1589. Shift: TShiftState);
  1590. begin
  1591. if (ssCtrl in Shift) and (ssShift in Shift) and (ssAlt in Shift)
  1592. and (Key in [67, 99]) then // 'c', 'C'
  1593. extvReport.FullCollapse;
  1594. end;
  1595. procedure TReportsForm.ExportReportPage(APage: Integer;
  1596. const APageFileName: string; AOrg: Boolean);
  1597. var
  1598. bmp, bmpCut: TBitmap;
  1599. img: TJPEGImage;
  1600. iCutHeight, iCutWidth, iCutTop, iCutLeft, iCutRight, iCutBottom: Integer;
  1601. begin
  1602. bmp := TBitmap.Create;
  1603. bmpCut := TBitmap.Create;
  1604. img := TJPEGImage.Create;
  1605. try
  1606. bmp.Height := PreviewComXML.ReportSize.Y;
  1607. bmp.Width := PreviewComXML.ReportSize.X;
  1608. PreviewComXML.PrintPreviewCanvas(APage, 0, bmp.Canvas, False);
  1609. iCutHeight := Round(PreviewComXML.ReportSize.Y / 200);
  1610. iCutWidth := Round(PreviewComXML.ReportSize.X / 200);
  1611. bmpCut.Height := PreviewComXML.ReportSize.Y - iCutHeight * 2;
  1612. bmpCut.Width := PreviewComXML.ReportSize.X - iCutWidth * 2;
  1613. bmpCut.Canvas.CopyRect(Rect(0, 0, bmpCut.Width, bmpCut.Height), bmp.Canvas, Rect(iCutWidth, iCutHeight, bmp.Width - iCutWidth, bmp.Height - iCutHeight));
  1614. if not AOrg then
  1615. img.Assign(bmpCut)
  1616. else
  1617. img.Assign(bmp);
  1618. img.CompressionQuality := 100;
  1619. img.Compress;
  1620. img.SaveToFile(APageFileName);
  1621. finally
  1622. bmpCut.Free;
  1623. bmp.Free;
  1624. img.Free;
  1625. end;
  1626. end;
  1627. end.