ReportsFrm.pas 51 KB

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