ReportsFrm.pas 52 KB

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