ReportsFrm.pas 44 KB

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