ReportsFrm.pas 52 KB

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