ReportsFrm.pas 51 KB

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