ReportsFrm.pas 48 KB

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