ReportsFrm.pas 51 KB

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