ReportsFrm.pas 51 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713
  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. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  705. end else if (isPrinting) then
  706. begin
  707. if (dataType = DATA_TYPE_DOUBLE) or (dataType = DATA_TYPE_FLOAT) then
  708. begin
  709. contentFontRec.FontName := 'Arial Narrow';
  710. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 7 div 6;
  711. end else
  712. begin
  713. contentFontRec.FontName := ReportConfig.ContentFont.Name;
  714. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  715. end;
  716. end else
  717. begin
  718. if (dataType = DATA_TYPE_DOUBLE) or (dataType = DATA_TYPE_FLOAT) then
  719. begin
  720. contentFontRec.FontName := 'Arial Narrow';
  721. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  722. end else
  723. begin
  724. contentFontRec.FontName := ReportConfig.ContentFont.Name;
  725. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  726. end;
  727. end;
  728. end;
  729. end;
  730. end;
  731. procedure TReportsForm.xlbSetupClick(Sender: TObject);
  732. begin
  733. if AdjustReport then
  734. LoadTempletAndDisplay;
  735. end;
  736. procedure TReportsForm.InitReportSettings(APrintCom: TPrintComXML; ATemplate: TTemplateNode);
  737. begin
  738. APrintCom.FillZero := chkFillZero.Checked;
  739. InitPageSettings(APrintCom);
  740. InitPaperSettings(ATemplate, APrintCom);
  741. {APrintCom.ShowBackgroundMark := FProjectData.ProjProperties.ShowReportShading;
  742. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShading;}
  743. if FProjectData.ProjProperties.ReportShowState then
  744. begin
  745. if FProjectData.ProjProperties.ReportShowStateWithoutReply and
  746. ((FProjectData.ProjProperties.AuditStatus = -1) or (FProjectData.PhaseIndex < FProjectData.ProjProperties.PhaseCount)) then
  747. APrintCom.ShowBackgroundMark := False
  748. else
  749. APrintCom.ShowBackgroundMark := True;
  750. end
  751. else
  752. APrintCom.ShowBackgroundMark := False;
  753. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShowStateText;
  754. end;
  755. procedure TReportsForm.InitPageSettings(APrintCom: TPrintComXML);
  756. begin
  757. // 设置页面大小
  758. APrintCom.setPageSize(ReportConfig.PageSize);
  759. if ReportConfig.PageSize = 'A3' then
  760. APrintCom.PrintPageSizeIdx := DMPAPER_A3
  761. else if ReportConfig.PageSize = 'A4' then
  762. APrintCom.PrintPageSizeIdx := DMPAPER_A4;
  763. // 设置边距
  764. APrintCom.setEdge(0, '', ReportConfig.LeftEdge/10);
  765. APrintCom.setEdge(1, '', ReportConfig.RightEdge/10);
  766. APrintCom.setEdge(2, '', ReportConfig.UpEdge/10);
  767. APrintCom.setEdge(3, '', ReportConfig.DownEdge/10);
  768. end;
  769. procedure TReportsForm.InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  770. procedure InitRepBorderLine;
  771. var
  772. i: Integer;
  773. ObjList : TList;
  774. ShapeRec : PPicRec;
  775. begin
  776. ObjList := TList.Create;
  777. try
  778. APrintCom.getAllShapeObjs(1, ObjList);
  779. for i := 0 to ObjList.Count - 1 do
  780. begin
  781. ShapeRec := ObjList[i];
  782. // 设置报表边框线粗
  783. ShapeRec.PenWidth := ReportConfig.BorderLine;
  784. // 设置是否绘制报表边框横线
  785. if (ShapeRec.ExArea.ExLeft <> ShapeRec.ExArea.ExRight) then
  786. begin
  787. if not ReportConfig.RepBorderUnderLine then
  788. ShapeRec.PenStyle := integer(psClear)
  789. else
  790. ShapeRec.PenStyle := integer(psSolid);
  791. end;
  792. // 设置是否绘制报表边框竖线
  793. if (ShapeRec.ExArea.ExTop <> ShapeRec.ExArea.ExBottom) and
  794. ((ShapeRec.ExArea.ExLeft = 0) or (ShapeRec.ExArea.ExLeft = 100)) then
  795. begin //这里的判断条件是约定好的
  796. if not ReportConfig.RepBorderVerLine then
  797. ShapeRec.PenStyle := integer(psClear)
  798. else
  799. ShapeRec.PenStyle := integer(psSolid)
  800. end;
  801. APrintCom.setShapeObj(ShapeRec);
  802. end;
  803. finally
  804. ObjList.Free;
  805. end;
  806. end;
  807. procedure InitRepCellLine;
  808. var
  809. i: Integer;
  810. ObjList : TList;
  811. ColumnRec : PColumnRec;
  812. FlowContentRec : PContentRec;
  813. CrossContentRec : PCrossContentRec;
  814. begin
  815. ObjList := TList.Create;
  816. try
  817. APrintCom.getAllFlowShowContentObjs(ObjList);
  818. // 设置报表表格横线
  819. for i := 0 to ObjList.Count - 1 do
  820. begin
  821. FlowContentRec := ObjList[i];
  822. FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  823. FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  824. APrintCom.setFlowContentObj(FlowContentRec);
  825. end;
  826. APrintCom.getAllCrossContentObjs(ObjList);
  827. for i := 0 to ObjList.Count - 1 do
  828. begin
  829. CrossContentRec := ObjList[i];
  830. CrossContentRec.CrossContent.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  831. CrossContentRec.CrossContent.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  832. APrintCom.setCrossContentObj(CrossContentRec);
  833. end;
  834. // 设置报表表格竖线
  835. APrintCom.getAllFlowShowContentObjs(ObjList);
  836. for i := 0 to ObjList.Count - 1 do
  837. begin
  838. FlowContentRec := ObjList[i];
  839. FlowContentRec.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  840. FlowContentRec.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  841. // 如果设置无表格边框线,则两端的表格竖线线粗为0
  842. if (not ReportConfig.RepBorderVerLine) then
  843. if (i = 0) then
  844. FlowContentRec.LineInfo.LeftThick := 0
  845. else if (i = ObjList.Count - 1) then
  846. FlowContentRec.LineInfo.RightThick := 0;
  847. APrintCom.setFlowContentObj(FlowContentRec);
  848. end;
  849. APrintCom.getAllCrossContentObjs(ObjList);
  850. for i := 0 to ObjList.Count - 1 do
  851. begin
  852. CrossContentRec := ObjList[i];
  853. CrossContentRec.CrossContent.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  854. CrossContentRec.CrossContent.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  855. ColumnRec := CrossContentRec.CrossContent.Column;
  856. //这里还要判断如果没有边框竖线的情况下,表格竖线边缘的线粗也为0
  857. //前提是所属表栏最右位置位于边缘
  858. if (not ReportConfig.RepBorderVerLine) and (ColumnRec<>nil) and
  859. ((ColumnRec.ExArea.ExRight = 100.0) or (ColumnRec.ExArea.ExLeft = 0.0)) then
  860. begin
  861. case CrossContentRec.CrossType of
  862. 0 : //交叉行
  863. begin
  864. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  865. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  866. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  867. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  868. end;
  869. 1 : //交叉列
  870. begin
  871. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  872. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  873. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  874. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  875. //(*
  876. if (CrossContentRec.CrossContent.isSpecialBorder) then
  877. begin
  878. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  879. CrossContentRec.CrossContent.SpecialLineInfo.RightThick := 0;
  880. end;
  881. //*)
  882. end;
  883. 2 : //显示数据
  884. begin
  885. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  886. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  887. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  888. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  889. end;
  890. 3 : //固定LABEL
  891. begin
  892. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  893. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  894. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  895. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  896. end;
  897. 4 : //序号
  898. begin
  899. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  900. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  901. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  902. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  903. end;
  904. 5 : //横向统计
  905. begin
  906. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  907. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  908. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  909. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  910. end;
  911. end;
  912. end;
  913. APrintCom.setCrossContentObj(CrossContentRec);
  914. end;
  915. finally
  916. ObjList.Free;
  917. end;
  918. end;
  919. procedure InitOtherArea;
  920. procedure SetPTRBorder(PTR : PTextRec);
  921. procedure SetLeftRightBorder;
  922. begin
  923. if PTR.ExArea.ExLeft = 0.0 then
  924. begin
  925. if BorderWidth = 0.0 then
  926. PTR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth;
  927. end;
  928. if PTR.ExArea.ExRight = 100.0 then
  929. begin
  930. if BorderWidth = 0.0 then
  931. PTR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth
  932. end;
  933. end;
  934. procedure SetHorLine;
  935. begin
  936. if (PTR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  937. PTR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  938. if (PTR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  939. PTR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  940. end;
  941. begin
  942. SetLeftRightBorder;
  943. SetHorLine;
  944. end;
  945. procedure SetPCRBorder(PCR : PColumnRec);
  946. procedure SetLeftRightBorder;
  947. begin
  948. if PCR.ExArea.ExLeft = 0.0 then
  949. begin
  950. if BorderWidth = 0.0 then
  951. PCR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth
  952. end;
  953. if PCR.ExArea.ExRight = 100.0 then
  954. begin
  955. if BorderWidth = 0.0 then
  956. PCR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth;
  957. end;
  958. end;
  959. procedure SetVerLine;
  960. begin
  961. if PCR.ExArea.ExLeft = 0.0 then
  962. PCR.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  963. if PCR.ExArea.ExRight = 100.0 then
  964. PCR.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  965. end;
  966. procedure SetHorLine;
  967. begin
  968. if (PCR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  969. PCR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  970. if (PCR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  971. PCR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  972. end;
  973. begin
  974. SetLeftRightBorder;
  975. SetVerLine;
  976. SetHorLine;
  977. end;
  978. var i,k : integer;
  979. ObjList : TList;
  980. ActAreaRec : PActiveAreaRec;
  981. PSR : PShowElementRec;
  982. begin
  983. ObjList := TList.Create;
  984. try
  985. ActAreaRec := nil;
  986. PreviewComXML.getAllActAreaObjs(ObjList);
  987. for i := 0 to ObjList.Count - 1 do
  988. begin
  989. ActAreaRec := ObjList[i];
  990. if (ActAreaRec.ShowType < 0) or (ActAreaRec.ShowType > 2) then Continue;
  991. if not Assigned(ActAreaRec.ElementList) then Continue;
  992. for k := 0 to ActAreaRec.ElementList.Count - 1 do
  993. begin
  994. PSR := PShowElementRec(ActAreaRec.ElementList[k]);
  995. case PSR.ElementType of
  996. 0..2 : SetPTRBorder(PSR.Data); //文本,参数,字段,表栏
  997. 7 : SetPCRBorder(PSR.Data) //Column
  998. end;
  999. APrintCom.setActShowElementObj(PSR);
  1000. end;
  1001. end;
  1002. finally
  1003. ObjList.Free;
  1004. end;
  1005. end;
  1006. begin
  1007. if not Assigned(ATemplate) or (ATemplate.SelfFormat = 0) then
  1008. begin
  1009. InitFont(APrintCom); // 各类字体
  1010. InitRepBorderLine; // 报表边框
  1011. InitRepCellLine; // 报表表格
  1012. InitOtherArea; // 活动区域
  1013. end;
  1014. end;
  1015. procedure TReportsForm.PreviewComXMLCrossTabLabelShow(valIDX: Integer;
  1016. var ExLeft, ExRight: Double; var isShow: Boolean;
  1017. CrsTabShowType: Integer);
  1018. var field : PFieldRec;
  1019. begin
  1020. if (CrsTabShowType = -1) then exit;
  1021. field := PreviewComXML.getFieldByID(6);
  1022. if (field <> nil) then
  1023. begin
  1024. if (field.DataLen > valIDX) and (valIDX >= 0) then
  1025. begin
  1026. if (field.Value[valIDX] = 1.5) then
  1027. begin
  1028. case CrsTabShowType of
  1029. 1 : begin
  1030. isShow := false;
  1031. end;
  1032. 2 : begin
  1033. ExLeft := 0;
  1034. ExRight := 100;
  1035. end;
  1036. 3 : begin
  1037. //
  1038. end
  1039. else
  1040. begin
  1041. //
  1042. end;
  1043. end;
  1044. end;
  1045. end;
  1046. end;
  1047. end;
  1048. procedure TReportsForm.rdbtnA4Click(Sender: TObject);
  1049. begin
  1050. ReportConfig.PageSize := TRadioButton(Sender).Caption;
  1051. SetPrinterPageSize(ReportConfig.PageSize);
  1052. LoadTempletAndDisplay;
  1053. end;
  1054. procedure TReportsForm.chkFillZeroClick(Sender: TObject);
  1055. begin
  1056. PreviewComXML.FillZero := chkFillZero.Checked;
  1057. PreviewReportCurPage;
  1058. end;
  1059. procedure TReportsForm.InitFont(APrintCom: TPrintComXML);
  1060. procedure AssignFontRec(AFontRec: TFontRec; AFont: TFont);
  1061. begin
  1062. AFontRec.FontName := AFont.Name;
  1063. AFontRec.FontHeight := Round(AFont.Size*4/3) ;
  1064. AFontRec.FontBold := 400 + Integer(fsBold in AFont.Style)*200;
  1065. AFontRec.FontItalic := Integer(fsItalic in AFont.Style);
  1066. AFontRec.FontUnderLine := Integer(fsUnderLine in AFont.Style);
  1067. end;
  1068. procedure InitTitleFont;
  1069. var
  1070. TitleRec : PTitleRec;
  1071. begin
  1072. TitleRec := PreviewComXML.getTitleByID(1);
  1073. if TitleRec <> nil then
  1074. begin
  1075. AssignFontRec(TitleRec.FontRec, ReportConfig.TitleFont);
  1076. APrintCom.setTitleObj(TitleRec);
  1077. end;
  1078. end;
  1079. procedure InitColumnFont;
  1080. procedure InitColumnThick(AColumnRec: PColumnRec);
  1081. begin
  1082. if (ReportConfig.ReportCellLine > 0.2) then
  1083. begin
  1084. if (AColumnRec.LineInfo.LeftThick > 0.2) then
  1085. AColumnRec.LineInfo.LeftThick := ReportConfig.ReportCellLine;
  1086. if (AColumnRec.LineInfo.RightThick > 0.2) then
  1087. AColumnRec.LineInfo.RightThick := ReportConfig.ReportCellLine;
  1088. if (AColumnRec.LineInfo.TopThick > 0.2) then
  1089. AColumnRec.LineInfo.TopThick := ReportConfig.ReportCellLine;
  1090. if (AColumnRec.LineInfo.BottomThick > 0.2) then
  1091. AColumnRec.LineInfo.BottomThick := ReportConfig.ReportCellLine;
  1092. end;
  1093. end;
  1094. var
  1095. i, j: Integer;
  1096. ObjList: TList;
  1097. ColumnRec : PColumnRec;
  1098. AAR : PActiveAreaRec;
  1099. SER : PShowElementRec;
  1100. begin
  1101. ObjList := TList.Create;
  1102. try
  1103. APrintCom.getAllColumnHeadObjs(ObjList);
  1104. for i := 0 to ObjList.Count - 1 do
  1105. begin
  1106. ColumnRec := ObjList[i];
  1107. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1108. InitColumnThick(ColumnRec);
  1109. APrintCom.setColumnHeadTailObj(0, ColumnRec);
  1110. end;
  1111. APrintCom.getAllColumnTailObjs(ObjList);
  1112. for i := 0 to ObjList.Count - 1 do
  1113. begin
  1114. ColumnRec := ObjList[i];
  1115. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1116. InitColumnThick(ColumnRec);
  1117. APrintCom.setColumnHeadTailObj(1,ColumnRec);
  1118. end;
  1119. APrintCom.getAllActAreaObjs(ObjList);
  1120. for i := 0 to ObjList.Count - 1 do
  1121. begin
  1122. AAR := ObjList[i];
  1123. for j := 0 to AAR.ElementList.Count - 1 do
  1124. begin
  1125. SER := AAR.ElementList[j];
  1126. if (SER.ElementType = 7) then
  1127. begin
  1128. ColumnRec := SER.Data;
  1129. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1130. InitColumnThick(ColumnRec);
  1131. APrintCom.setActShowElementObj(SER);
  1132. end;
  1133. end;
  1134. end;
  1135. finally
  1136. ObjList.Free;
  1137. end;
  1138. end;
  1139. procedure InitContentAndGatherFont;
  1140. var
  1141. i, j: Integer;
  1142. ObjList: TList;
  1143. FlowContentRec : PContentRec;
  1144. CrossContentRec : PCrossContentRec;
  1145. SumRec : PSumRec;
  1146. begin
  1147. ObjList := TList.Create;
  1148. try
  1149. // 设置表正文
  1150. APrintCom.getAllFlowShowContentObjs(ObjList);
  1151. for i := 0 to ObjList.Count - 1 do
  1152. begin
  1153. FlowContentRec := ObjList[i];
  1154. if not (FlowContentRec.Fixed) then
  1155. begin
  1156. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1157. APrintCom.setFlowContentObj(FlowContentRec);
  1158. end;
  1159. end;
  1160. APrintCom.getAllBillShowContentObjs(ObjList);
  1161. for i := 0 to ObjList.Count - 1 do
  1162. begin
  1163. FlowContentRec := ObjList[i];
  1164. if not(FlowContentRec.Fixed) then
  1165. begin
  1166. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1167. APrintCom.setBillContentObj(FlowContentRec);
  1168. end;
  1169. end;
  1170. APrintCom.getAllCrossContentObjs(ObjList);
  1171. for i := 0 to ObjList.Count - 1 do
  1172. begin
  1173. CrossContentRec := ObjList[i];
  1174. if not(CrossContentRec.CrossContent.Fixed) then
  1175. begin
  1176. AssignFontRec(CrossContentRec.CrossContent.FontRec, ReportConfig.ContentFont);
  1177. APrintCom.setCrossContentObj(CrossContentRec);
  1178. end;
  1179. end;
  1180. // 设置表合计
  1181. for i := 0 to 2 do
  1182. begin
  1183. APrintCom.getAllSumObjs(i,ObjList);
  1184. for j := 0 to ObjList.Count - 1 do
  1185. begin
  1186. SumRec := ObjList[j];
  1187. AssignFontRec(SumRec.FontRec, ReportConfig.GatherFont);
  1188. APrintCom.setSumObj(SumRec);
  1189. end;
  1190. end;
  1191. finally
  1192. ObjList.Free;
  1193. end;
  1194. end;
  1195. procedure InitGridHeaderFont;
  1196. var
  1197. i: Integer;
  1198. ObjList: TList;
  1199. HeadTailRec : PHeadRec;
  1200. begin
  1201. ObjList := TList.Create;
  1202. try
  1203. APrintCom.getAllHeadObjs(ObjList);
  1204. for i := 0 to ObjList.Count - 1 do
  1205. begin
  1206. HeadTailRec := ObjList[i];
  1207. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1208. APrintCom.setHeadTailObj(0, HeadTailRec);
  1209. end;
  1210. APrintCom.getAllTailObjs(ObjList);
  1211. for i := 0 to ObjList.Count - 1 do
  1212. begin
  1213. HeadTailRec := ObjList[i];
  1214. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1215. APrintCom.setHeadTailObj(1, HeadTailRec);
  1216. end;
  1217. finally
  1218. ObjList.Free;
  1219. end;
  1220. end;
  1221. begin
  1222. InitTitleFont;
  1223. InitColumnFont;
  1224. InitContentAndGatherFont;
  1225. InitGridHeaderFont;
  1226. end;
  1227. procedure TReportsForm.PreviewComXMLGetDatasetEvent(
  1228. DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet);
  1229. begin
  1230. if DatasetInfo.ID = 0 then
  1231. ADataSet := MemoryReportManager.GetSqlResultDataSet(ReportTemplateManager.Current.InteractInfo.Sql, FProjectData)
  1232. else
  1233. ADataset := MemoryReportManager.GetMemoryDataSet(DatasetInfo.ID, FProjectData);
  1234. end;
  1235. function TReportsForm.GetIsExcel2010: Boolean;
  1236. begin
  1237. Result := chkExcel2010.Checked;
  1238. end;
  1239. procedure TReportsForm.InitFormView;
  1240. begin
  1241. rdbtnA3.Checked := SameText(rdbtnA3.Caption, ReportConfig.PageSize);
  1242. rdbtnA4.Checked := SameText(rdbtnA4.Caption, ReportConfig.PageSize);
  1243. SetPrinterPageSize(ReportConfig.PageSize);
  1244. pnlSearch.Visible := _IsDebugView;
  1245. if G_IsCloud then
  1246. begin
  1247. btnRMgr.Visible := True;
  1248. tbImportSrt.Visible := False;
  1249. end
  1250. else
  1251. begin
  1252. btnRMgr.Visible := False;
  1253. tbImportSrt.Visible := True;
  1254. end;
  1255. end;
  1256. procedure TReportsForm.LoadExcelBorder(var Border: TColumnLineRec);
  1257. begin
  1258. Border.LeftThick := 0.5;
  1259. Border.TopThick := 0.5;
  1260. Border.RightThick := 0.5;
  1261. Border.BottomThick := 0.5;
  1262. if not ReportConfig.RepBorderVerLine then
  1263. begin
  1264. Border.LeftThick := 0;
  1265. Border.RightThick := 0;
  1266. end;
  1267. end;
  1268. procedure TReportsForm.PrintReport(ATemplateNode: TTemplateNode;
  1269. isPDF, isExcel: boolean; ExcelOutputName, TemplateFileName: string);
  1270. function CheckPrinterReady: Boolean;
  1271. var
  1272. PrinterHD: THandle;
  1273. NoJobs: Word;
  1274. s: LongWord;
  1275. Job_Info: Array[0..10] of Job_INFO_1;
  1276. cbNeeded: Cardinal;
  1277. cReturned: Cardinal;
  1278. ret: LongBool;
  1279. begin
  1280. if OpenPrinter(PChar(Printer.Printers[Printer.PrinterIndex]), PrinterHD, 0) then
  1281. begin
  1282. s := SizeOf(Job_Info);
  1283. cbNeeded := 0;
  1284. cReturned := 0;
  1285. NoJobs := 10;
  1286. ret := ENumJobs(PrinterHD, 0, NoJobs, 1, @Job_Info, s, cbNeeded, cReturned);
  1287. Result := not((cReturned > 0) and (Job_Info[0].TotalPages > 0));
  1288. end
  1289. else
  1290. Result := True;
  1291. end;
  1292. procedure PrintTemplet;
  1293. var
  1294. sFileName: string;
  1295. begin
  1296. if isPDF then
  1297. begin
  1298. sFileName := BatchPrintXml.ReportName + '.pdf';
  1299. if SaveFile(sFileName, '.pdf') then
  1300. PdfHelper.ExportAllPages(BatchPrintXml, sFileName);
  1301. (*
  1302. BatchPrintXml.PrintPDFAll(PreviewBox.Canvas);
  1303. while not CheckPrinterReady do
  1304. Sleep(1000);
  1305. *)
  1306. end
  1307. else if not isExcel then
  1308. BatchPrintXml.PrintAll(PreviewBox.Canvas, 1)
  1309. else
  1310. ExportXlsReport(1, BatchPrintXml.TotalPages, ExcelOutputName, BatchPrintXml);
  1311. end;
  1312. var
  1313. strRptName : string;
  1314. begin
  1315. if not FileExists(ATemplateNode.FileName) then Exit;
  1316. ClearReportOprList;
  1317. ClearReportFuncList;
  1318. Screen.Cursor := crHourGlass;
  1319. try
  1320. LoadTemplet(ATemplateNode, BatchPrintXml);
  1321. if BatchPrintXml.TotalPages > 0 then
  1322. PrintTemplet
  1323. {else if strRptName <> '' then
  1324. begin
  1325. LoadTemplet(RptArchiverObj, strRptName);
  1326. PrintEmptyTemplet;
  1327. end;}
  1328. finally
  1329. Screen.Cursor := crDefault;
  1330. end;
  1331. end;
  1332. procedure TReportsForm.ExportXlsReport(AStartPage, AEndPage: Integer;
  1333. const AFileName: string; APrintCom: TPrintComXML);
  1334. procedure ExportPagesXlsReport(AStartPage, AEndPage: Integer; const AFileName: string);
  1335. var
  1336. Border : TColumnLineRec;
  1337. begin
  1338. LoadExcelBorder(Border);
  1339. if IsExcel2010 then
  1340. APrintCom.OutputToExcelFileOE(PreviewBox.Canvas, AStartPage, AEndPage, AFileName, ExcelMode, Border, nil)
  1341. else
  1342. //APrintCom.OutputToExcelFile(PreviewBox.Canvas, AStartPage, AEndPage, GetTemplateXlsFileName, AFileName, ExcelMode, Border);
  1343. APrintCom.OutputToExcelFileOE(PreviewBox.Canvas, AStartPage, AEndPage, AFileName, ExcelMode, Border, nil);
  1344. //现2010格式与之前格式应用同一控件导出
  1345. end;
  1346. var
  1347. iStartPage, iEndPage, iCount: Integer;
  1348. sFileName: string;
  1349. begin
  1350. BeforeExport;
  1351. try
  1352. if (ExcelMode = oemNormal) and (PrintEndPage - PrintStartPage > 30) then
  1353. begin
  1354. iStartPage := PrintStartPage;
  1355. iEndPage := iStartPage + 19;
  1356. iCount := 1;
  1357. repeat
  1358. begin
  1359. if IsExcel2010 then
  1360. sFileName := Format('%s[%d].xlsx', [ExtractSimpleFileName(AFileName), iCount])
  1361. else
  1362. sFileName := Format('%s[%d].xls', [ExtractSimpleFileName(AFileName), iCount]);
  1363. ExportPagesXlsReport(iStartPage, iEndPage, sFileName);
  1364. iStartPage := iStartPage + 20;
  1365. iEndPage := Min(iEndPage + 20, PrintEndPage);
  1366. Inc(iCount);
  1367. end
  1368. until iStartPage > iEndPage;
  1369. end
  1370. else
  1371. ExportPagesXlsReport(AStartPage, AEndPage, AFileName);
  1372. finally
  1373. AfterExport;
  1374. end;
  1375. end;
  1376. procedure TReportsForm.LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  1377. var
  1378. RptArchiverObj: TReportArchiver;
  1379. Mem: TMemoryStream;
  1380. begin
  1381. RptArchiverObj := TReportArchiver.Create;
  1382. if ATemplate.IsMulti then
  1383. RptArchiverObj.FileName := ATemplate.MultiFileNames[FProjectData.PhaseIndex]
  1384. else
  1385. RptArchiverObj.FileName := ATemplate.FileName;
  1386. Mem := RptArchiverObj.Extract;
  1387. try
  1388. // 以下代码有顺序限制,不可修改,主要保证在不修改报表模板文件的基础上可以用户定制报表格式
  1389. // 私以为,原因在于这些设置修改后,并不能生效,需要保存再读取方可生效
  1390. // 读取报表模板
  1391. if not APrintCom.ReadReportStream(Mem) then Exit;
  1392. // 将报表设置中的数据覆盖掉原模板的数据
  1393. InitReportSettings(APrintCom, ATemplate);
  1394. // 保存
  1395. APrintCom.SaveToStream(Mem);
  1396. // 再次读取,使报表设置中的设置生效
  1397. APrintCom.ReadReportStream(Mem);
  1398. // ReadReportStream之后会将PreviewComXML的FillZero值赋为True,故再赋值一次
  1399. APrintCom.FillZero := chkFillZero.Checked;
  1400. InitPageSettings(APrintCom);
  1401. APrintCom.ReadDBData;
  1402. //设置好字体,否则Canvas的默认字体在计算自动行高的时候会出现偏差
  1403. PreviewBox.Canvas.Font.Name := ReportConfig.ContentFont.Name;
  1404. PreviewBox.Canvas.Font.Size := ReportConfig.ContentFont.Size;
  1405. APrintCom.AnalyseData(PreviewBox.Canvas);
  1406. finally
  1407. if Mem <> nil then
  1408. Mem.Free;
  1409. RptArchiverObj.Free;
  1410. end;
  1411. end;
  1412. function TReportsForm.GetHintStr: string;
  1413. begin
  1414. Result := #13#10 +
  1415. '对不起,学习版不提供报表打印、导出功能。'#13#10 +
  1416. #13#10 +
  1417. '以下为收费服务项目,请在必要时联系纵横:'#13#10 +
  1418. #13#10 +
  1419. '企业QQ:800003850 客服热线:(0756)3850888';
  1420. end;
  1421. function TReportsForm.GetSubClassNode(AClassNode: TExTreeNode;
  1422. ANode: TTemplateNode): TExTreeNode;
  1423. function FindNode(AParent: TExTreeNode; const AName: string): TExTreeNode;
  1424. var
  1425. I: Integer;
  1426. vNode: TExTreeNode;
  1427. begin
  1428. Result := nil;
  1429. if Assigned(AParent) then
  1430. vNode := AParent.getFirstChild
  1431. else
  1432. vNode := extvReport.Items.GetFirstNode;
  1433. while not Assigned(Result) and Assigned(vNode) do
  1434. begin
  1435. if SameText(vNode.Text, AName) then
  1436. Result := vNode;
  1437. vNode := vNode.getNextSibling;
  1438. end;
  1439. end;
  1440. begin
  1441. Result := FindNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1442. if not Assigned(Result) then
  1443. Result := AddClassNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1444. end;
  1445. function TReportsForm.AddClassNode(AParent: TExTreeNode;
  1446. const AName: string): TExTreeNode;
  1447. begin
  1448. Result := extvReport.Items.AddChildObject(AParent, AName, Pointer(nil));
  1449. Result.ImageIndex := 0;
  1450. Result.SelectedIndex := 1;
  1451. Result.Checked := csUnchecked;
  1452. Result.Expanded := True;
  1453. end;
  1454. procedure TReportsForm.SaveReportInteractData(ATemplate: TTemplateNode);
  1455. begin
  1456. case ATemplate.InteractFlag of
  1457. 1: SaveAuditOpinion(ATemplate);
  1458. end;
  1459. end;
  1460. procedure TReportsForm.SaveAuditOpinion(ATemplate: TTemplateNode);
  1461. var
  1462. SelectForm: TAuditSelctForm;
  1463. begin
  1464. SelectForm := TAuditSelctForm.Create(FProjectData, ATemplate);
  1465. try
  1466. if SelectForm.ShowModal = mrOk then
  1467. SelectForm.SaveAuditData;
  1468. finally
  1469. SelectForm.Free;
  1470. end;
  1471. end;
  1472. destructor TReportsForm.Destroy;
  1473. begin
  1474. FReportCon.Free;
  1475. FReportDataPrepare.Free;
  1476. inherited;
  1477. end;
  1478. // 启用报表模板管理器,报表导入功能取消。
  1479. procedure TReportsForm.btnRMgrClick(Sender: TObject);
  1480. var vRMForm: TReportManagerForm;
  1481. begin
  1482. Screen.Cursor := crHourGlass;
  1483. vRMForm := TReportManagerForm.Create(nil);
  1484. vRMForm.ReportsForm := Self;
  1485. try
  1486. vRMForm.ShowModal;
  1487. finally
  1488. vRMForm.Free;
  1489. Screen.Cursor := crDefault;
  1490. end;
  1491. end;
  1492. procedure TReportsForm.RefreshReportTemplets;
  1493. begin
  1494. ReportTemplateManager.RefreshTemplates;
  1495. LoadReportTemplets;
  1496. LoadTempletAndDisplay;
  1497. end;
  1498. procedure TReportsForm.FormActivate(Sender: TObject);
  1499. var vReports: TReports;
  1500. begin
  1501. // 自动检测并提醒用户有新报表要更新
  1502. if G_IsCloud then
  1503. begin
  1504. vReports := TReports.Create(nil);
  1505. try
  1506. if vReports.HasNeedUpdateReport then
  1507. begin
  1508. Application.MessageBox('系统检测到有新的报表可以更新!', '提示', MB_OK + MB_ICONINFORMATION);
  1509. btnRMgr.Click;
  1510. end;
  1511. finally
  1512. vReports.Free;
  1513. end;
  1514. end;
  1515. end;
  1516. procedure TReportsForm.imgSearchClick(Sender: TObject);
  1517. function SearchAfter(const AText: string; vBegin: TExTreeNode): TExTreeNode;
  1518. var
  1519. vNext: TExTreeNode;
  1520. begin
  1521. Result := nil;
  1522. vNext := vBegin.GetNext;
  1523. while Assigned(vNext) and not Assigned(Result) do
  1524. begin
  1525. if (Pos(AText, vNext.Text) > 0) then
  1526. Result := vNext;
  1527. vNext := vNext.GetNext;
  1528. end;
  1529. end;
  1530. function SearchBegin(const AText: string; vEnd: TExTreeNode): TExTreeNode;
  1531. var
  1532. vPre: TExTreeNode;
  1533. begin
  1534. Result := nil;
  1535. vPre := extvReport.Items.GetFirstNode;
  1536. while (vPre <> vEnd) and not Assigned(Result) do
  1537. begin
  1538. if (Pos(AText, vPre.Text) > 0) then
  1539. Result := vPre;
  1540. vPre := vPre.GetNext;
  1541. end;
  1542. end;
  1543. procedure SearchReportTemplate(const AText: string);
  1544. var
  1545. vNode: TExTreeNode;
  1546. begin
  1547. vNode := SearchAfter(AText, extvReport.Selected);
  1548. if not Assigned(vNode) then
  1549. vNode := SearchBegin(AText, extvReport.Selected);
  1550. if Assigned(vNode) then
  1551. begin
  1552. extvReport.Selected := vNode;
  1553. extvReport.OnClick(extvReport);
  1554. end
  1555. else
  1556. WarningMessage(Format('未找到含关键字“%s”的报表,请缩短关键字后查询', [AText]));
  1557. end;
  1558. begin
  1559. SearchReportTemplate(edtSearch.Text);
  1560. end;
  1561. procedure TReportsForm.extvReportKeyDown(Sender: TObject; var Key: Word;
  1562. Shift: TShiftState);
  1563. begin
  1564. if (ssCtrl in Shift) and (ssShift in Shift) and (ssAlt in Shift)
  1565. and (Key in [67, 99]) then // 'c', 'C'
  1566. extvReport.FullCollapse;
  1567. end;
  1568. end.