ReportsFrm.pas 47 KB

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