ReportsFrm.pas 44 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499
  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. var
  588. sFileName, sNewFileName: string;
  589. vTemplateNode: TTemplateNode;
  590. begin
  591. if SelectFile(sFileName, '.srt') then
  592. begin
  593. sNewFileName := GetReportTemplatePath + ExtractFileName(sFileName);
  594. if not FileExists(sNewFileName) then
  595. begin
  596. CopyFile(PChar(sFileName), PChar(sNewFileName), True);
  597. vTemplateNode := ReportTemplateManager.AddReportTemplate(sNewFileName);
  598. AddReportTemplate(vTemplateNode);
  599. end
  600. else
  601. if QuestMessage('已存在报表模板' + ExtractFileName(sFileName) + ',是否覆盖原模板?', Handle) then
  602. CopyFile(PChar(sFileName), PChar(sNewFileName), False)
  603. else
  604. Exit;
  605. end;
  606. end;
  607. procedure TReportsForm.tbDeleteSrtClick(Sender: TObject);
  608. var
  609. vTemplateNode: TTemplateNode;
  610. begin
  611. if not Assigned(extvReport.Selected) then Exit;
  612. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  613. if not Assigned(vTemplateNode) then Exit;
  614. extvReport.Items.Delete(extvReport.Selected);
  615. DeleteFile(vTemplateNode.FileName);
  616. ReportTemplateManager.DeleteReportTemplate(vTemplateNode);
  617. LoadTempletAndDisplay;
  618. end;
  619. procedure TReportsForm.tbExportSrtClick(Sender: TObject);
  620. var
  621. vTemplateNode: TTemplateNode;
  622. sFileName: string;
  623. begin
  624. if not Assigned(extvReport.Selected) then Exit;
  625. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  626. if not Assigned(vTemplateNode) then Exit;
  627. sFileName := vTemplateNode.TemplateName;
  628. if SaveFile(sFileName, '.srt') then
  629. begin
  630. if not FileExists(sFileName) or QuestMessage('存在同名文件,是否覆盖?', Handle) then
  631. CopyFile(PChar(vTemplateNode.FileName), PChar(sFileName), False);
  632. end;
  633. end;
  634. procedure TReportsForm.PreviewComXMLContentDisplay(
  635. var contentFontRec: TFontRec; dataType: Integer; isReading: Boolean;
  636. DrawType: Integer; isPrinting: Boolean);
  637. begin
  638. if ReportConfig.ContentIsNarrow then
  639. begin
  640. if (isReading) then
  641. begin
  642. begin
  643. contentFontRec.FontName := 'Arial Narrow';
  644. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  645. end;
  646. end else
  647. begin
  648. if (DrawType = 3) or (DrawType = 5) then
  649. begin
  650. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  651. end else if (isPrinting) then
  652. begin
  653. contentFontRec.FontName := 'Arial Narrow';
  654. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 7 div 6;
  655. end else
  656. begin
  657. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  658. end;
  659. end;
  660. end;
  661. end;
  662. procedure TReportsForm.xlbSetupClick(Sender: TObject);
  663. begin
  664. if AdjustReport then
  665. LoadTempletAndDisplay;
  666. end;
  667. procedure TReportsForm.InitReportSettings(ATemplate: TTemplateNode);
  668. begin
  669. PreviewComXML.FillZero := chkFillZero.Checked;
  670. InitPageSettings;
  671. InitPaperSettings(ATemplate);
  672. end;
  673. procedure TReportsForm.InitPageSettings;
  674. begin
  675. // 设置页面大小
  676. PreviewComXML.setPageSize(ReportConfig.PageSize);
  677. // 设置边距
  678. PreviewComXML.setEdge(0, '', ReportConfig.LeftEdge/10);
  679. PreviewComXML.setEdge(1, '', ReportConfig.RightEdge/10);
  680. PreviewComXML.setEdge(2, '', ReportConfig.UpEdge/10);
  681. PreviewComXML.setEdge(3, '', ReportConfig.DownEdge/10);
  682. end;
  683. procedure TReportsForm.InitPaperSettings(ATemplate: TTemplateNode);
  684. procedure InitRepBorderLine;
  685. var
  686. i: Integer;
  687. ObjList : TList;
  688. ShapeRec : PPicRec;
  689. begin
  690. ObjList := TList.Create;
  691. try
  692. PreviewComXML.getAllShapeObjs(1, ObjList);
  693. for i := 0 to ObjList.Count - 1 do
  694. begin
  695. ShapeRec := ObjList[i];
  696. // 设置报表边框线粗
  697. ShapeRec.PenWidth := ReportConfig.BorderLine;
  698. // 设置是否绘制报表边框横线
  699. if (ShapeRec.ExArea.ExLeft <> ShapeRec.ExArea.ExRight) then
  700. begin
  701. if not ReportConfig.RepBorderUnderLine then
  702. ShapeRec.PenStyle := integer(psClear)
  703. else
  704. ShapeRec.PenStyle := integer(psSolid);
  705. end;
  706. // 设置是否绘制报表边框竖线
  707. if (ShapeRec.ExArea.ExTop <> ShapeRec.ExArea.ExBottom) and
  708. ((ShapeRec.ExArea.ExLeft = 0) or (ShapeRec.ExArea.ExLeft = 100)) then
  709. begin //这里的判断条件是约定好的
  710. if not ReportConfig.RepBorderVerLine then
  711. ShapeRec.PenStyle := integer(psClear)
  712. else
  713. ShapeRec.PenStyle := integer(psSolid)
  714. end;
  715. PreviewComXML.setShapeObj(ShapeRec);
  716. end;
  717. finally
  718. ObjList.Free;
  719. end;
  720. end;
  721. procedure InitRepCellLine;
  722. var
  723. i: Integer;
  724. ObjList : TList;
  725. ColumnRec : PColumnRec;
  726. FlowContentRec : PContentRec;
  727. CrossContentRec : PCrossContentRec;
  728. begin
  729. ObjList := TList.Create;
  730. try
  731. PreviewComXML.getAllFlowShowContentObjs(ObjList);
  732. // 设置报表表格横线
  733. for i := 0 to ObjList.Count - 1 do
  734. begin
  735. FlowContentRec := ObjList[i];
  736. FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  737. FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  738. PreviewComXML.setFlowContentObj(FlowContentRec);
  739. end;
  740. PreviewComXML.getAllCrossContentObjs(ObjList);
  741. for i := 0 to ObjList.Count - 1 do
  742. begin
  743. CrossContentRec := ObjList[i];
  744. CrossContentRec.CrossContent.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  745. CrossContentRec.CrossContent.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  746. PreviewComXML.setCrossContentObj(CrossContentRec);
  747. end;
  748. // 设置报表表格竖线
  749. PreviewComXML.getAllFlowShowContentObjs(ObjList);
  750. for i := 0 to ObjList.Count - 1 do
  751. begin
  752. FlowContentRec := ObjList[i];
  753. FlowContentRec.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  754. FlowContentRec.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  755. // 如果设置无表格边框线,则两端的表格竖线线粗为0
  756. if (not ReportConfig.RepBorderVerLine) then
  757. if (i = 0) then
  758. FlowContentRec.LineInfo.LeftThick := 0
  759. else if (i = ObjList.Count - 1) then
  760. FlowContentRec.LineInfo.RightThick := 0;
  761. PreviewComXML.setFlowContentObj(FlowContentRec);
  762. end;
  763. PreviewComXML.getAllCrossContentObjs(ObjList);
  764. for i := 0 to ObjList.Count - 1 do
  765. begin
  766. CrossContentRec := ObjList[i];
  767. CrossContentRec.CrossContent.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  768. CrossContentRec.CrossContent.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  769. ColumnRec := CrossContentRec.CrossContent.Column;
  770. //这里还要判断如果没有边框竖线的情况下,表格竖线边缘的线粗也为0
  771. //前提是所属表栏最右位置位于边缘
  772. if (not ReportConfig.RepBorderVerLine) and (ColumnRec<>nil) and
  773. ((ColumnRec.ExArea.ExRight = 100.0) or (ColumnRec.ExArea.ExLeft = 0.0)) then
  774. begin
  775. case CrossContentRec.CrossType of
  776. 0 : //交叉行
  777. begin
  778. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  779. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  780. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  781. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  782. end;
  783. 1 : //交叉列
  784. begin
  785. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  786. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  787. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  788. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  789. //(*
  790. if (CrossContentRec.CrossContent.isSpecialBorder) then
  791. begin
  792. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  793. CrossContentRec.CrossContent.SpecialLineInfo.RightThick := 0;
  794. end;
  795. //*)
  796. end;
  797. 2 : //显示数据
  798. begin
  799. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  800. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  801. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  802. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  803. end;
  804. 3 : //固定LABEL
  805. begin
  806. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  807. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  808. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  809. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  810. end;
  811. 4 : //序号
  812. begin
  813. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  814. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  815. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  816. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  817. end;
  818. 5 : //横向统计
  819. begin
  820. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  821. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  822. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  823. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  824. end;
  825. end;
  826. end;
  827. PreviewComXML.setCrossContentObj(CrossContentRec);
  828. end;
  829. finally
  830. ObjList.Free;
  831. end;
  832. end;
  833. procedure InitOtherArea;
  834. procedure SetPTRBorder(PTR : PTextRec);
  835. procedure SetLeftRightBorder;
  836. begin
  837. if PTR.ExArea.ExLeft = 0.0 then
  838. begin
  839. if BorderWidth = 0.0 then
  840. PTR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth;
  841. end;
  842. if PTR.ExArea.ExRight = 100.0 then
  843. begin
  844. if BorderWidth = 0.0 then
  845. PTR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth
  846. end;
  847. end;
  848. procedure SetHorLine;
  849. begin
  850. if (PTR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  851. PTR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  852. if (PTR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  853. PTR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  854. end;
  855. begin
  856. SetLeftRightBorder;
  857. SetHorLine;
  858. end;
  859. procedure SetPCRBorder(PCR : PColumnRec);
  860. procedure SetLeftRightBorder;
  861. begin
  862. if PCR.ExArea.ExLeft = 0.0 then
  863. begin
  864. if BorderWidth = 0.0 then
  865. PCR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth
  866. end;
  867. if PCR.ExArea.ExRight = 100.0 then
  868. begin
  869. if BorderWidth = 0.0 then
  870. PCR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth;
  871. end;
  872. end;
  873. procedure SetVerLine;
  874. begin
  875. if PCR.ExArea.ExLeft = 0.0 then
  876. PCR.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  877. if PCR.ExArea.ExRight = 100.0 then
  878. PCR.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  879. end;
  880. procedure SetHorLine;
  881. begin
  882. if (PCR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  883. PCR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  884. if (PCR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  885. PCR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  886. end;
  887. begin
  888. SetLeftRightBorder;
  889. SetVerLine;
  890. SetHorLine;
  891. end;
  892. var i,k : integer;
  893. ObjList : TList;
  894. ActAreaRec : PActiveAreaRec;
  895. PSR : PShowElementRec;
  896. begin
  897. ObjList := TList.Create;
  898. try
  899. ActAreaRec := nil;
  900. PreviewComXML.getAllActAreaObjs(ObjList);
  901. for i := 0 to ObjList.Count - 1 do
  902. begin
  903. ActAreaRec := ObjList[i];
  904. if (ActAreaRec.ShowType < 0) or (ActAreaRec.ShowType > 2) then Continue;
  905. if not Assigned(ActAreaRec.ElementList) then Continue;
  906. for k := 0 to ActAreaRec.ElementList.Count - 1 do
  907. begin
  908. PSR := PShowElementRec(ActAreaRec.ElementList[k]);
  909. case PSR.ElementType of
  910. 0..2 : SetPTRBorder(PSR.Data); //文本,参数,字段,表栏
  911. 7 : SetPCRBorder(PSR.Data) //Column
  912. end;
  913. PreviewComXML.setActShowElementObj(PSR);
  914. end;
  915. end;
  916. finally
  917. ObjList.Free;
  918. end;
  919. end;
  920. begin
  921. if not Assigned(ATemplate) or (ATemplate.SelfFormat = 0) then
  922. begin
  923. InitFont; // 各类字体
  924. InitRepBorderLine; // 报表边框
  925. InitRepCellLine; // 报表表格
  926. InitOtherArea; // 活动区域
  927. end;
  928. end;
  929. procedure TReportsForm.PreviewComXMLCrossTabLabelShow(valIDX: Integer;
  930. var ExLeft, ExRight: Double; var isShow: Boolean;
  931. CrsTabShowType: Integer);
  932. var field : PFieldRec;
  933. begin
  934. if (CrsTabShowType = -1) then exit;
  935. field := PreviewComXML.getFieldByID(6);
  936. if (field <> nil) then
  937. begin
  938. if (field.DataLen > valIDX) and (valIDX >= 0) then
  939. begin
  940. if (field.Value[valIDX] = 1.5) then
  941. begin
  942. case CrsTabShowType of
  943. 1 : begin
  944. isShow := false;
  945. end;
  946. 2 : begin
  947. ExLeft := 0;
  948. ExRight := 100;
  949. end;
  950. 3 : begin
  951. //
  952. end
  953. else
  954. begin
  955. //
  956. end;
  957. end;
  958. end;
  959. end;
  960. end;
  961. end;
  962. procedure TReportsForm.rdbtnA4Click(Sender: TObject);
  963. begin
  964. ReportConfig.PageSize := TRadioButton(Sender).Caption;
  965. SetPrinterPageSize(ReportConfig.PageSize);
  966. LoadTempletAndDisplay;
  967. end;
  968. procedure TReportsForm.chkFillZeroClick(Sender: TObject);
  969. begin
  970. PreviewComXML.FillZero := chkFillZero.Checked;
  971. PreviewReportCurPage;
  972. end;
  973. procedure TReportsForm.InitFont;
  974. procedure AssignFontRec(AFontRec: TFontRec; AFont: TFont);
  975. begin
  976. AFontRec.FontName := AFont.Name;
  977. AFontRec.FontHeight := Round(AFont.Size*4/3) ;
  978. AFontRec.FontBold := 400 + Integer(fsBold in AFont.Style)*200;
  979. AFontRec.FontItalic := Integer(fsItalic in AFont.Style);
  980. AFontRec.FontUnderLine := Integer(fsUnderLine in AFont.Style);
  981. end;
  982. procedure InitTitleFont;
  983. var
  984. TitleRec : PTitleRec;
  985. begin
  986. TitleRec := PreviewComXML.getTitleByID(1);
  987. if TitleRec <> nil then
  988. begin
  989. AssignFontRec(TitleRec.FontRec, ReportConfig.TitleFont);
  990. PreviewComXML.setTitleObj(TitleRec);
  991. end;
  992. end;
  993. procedure InitColumnFont;
  994. procedure InitColumnThick(AColumnRec: PColumnRec);
  995. begin
  996. if (ReportConfig.ReportCellLine > 0.2) then
  997. begin
  998. if (AColumnRec.LineInfo.LeftThick > 0.2) then
  999. AColumnRec.LineInfo.LeftThick := ReportConfig.ReportCellLine;
  1000. if (AColumnRec.LineInfo.RightThick > 0.2) then
  1001. AColumnRec.LineInfo.RightThick := ReportConfig.ReportCellLine;
  1002. if (AColumnRec.LineInfo.TopThick > 0.2) then
  1003. AColumnRec.LineInfo.TopThick := ReportConfig.ReportCellLine;
  1004. if (AColumnRec.LineInfo.BottomThick > 0.2) then
  1005. AColumnRec.LineInfo.BottomThick := ReportConfig.ReportCellLine;
  1006. end;
  1007. end;
  1008. var
  1009. i, j: Integer;
  1010. ObjList: TList;
  1011. ColumnRec : PColumnRec;
  1012. AAR : PActiveAreaRec;
  1013. SER : PShowElementRec;
  1014. begin
  1015. ObjList := TList.Create;
  1016. try
  1017. PreviewComXML.getAllColumnHeadObjs(ObjList);
  1018. for i := 0 to ObjList.Count - 1 do
  1019. begin
  1020. ColumnRec := ObjList[i];
  1021. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1022. InitColumnThick(ColumnRec);
  1023. PreviewComXML.setColumnHeadTailObj(0, ColumnRec);
  1024. end;
  1025. PreviewComXML.getAllColumnTailObjs(ObjList);
  1026. for i := 0 to ObjList.Count - 1 do
  1027. begin
  1028. ColumnRec := ObjList[i];
  1029. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1030. InitColumnThick(ColumnRec);
  1031. PreviewComXML.setColumnHeadTailObj(1,ColumnRec);
  1032. end;
  1033. PreviewComXML.getAllActAreaObjs(ObjList);
  1034. for i := 0 to ObjList.Count - 1 do
  1035. begin
  1036. AAR := ObjList[i];
  1037. for j := 0 to AAR.ElementList.Count - 1 do
  1038. begin
  1039. SER := AAR.ElementList[j];
  1040. if (SER.ElementType = 7) then
  1041. begin
  1042. ColumnRec := SER.Data;
  1043. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  1044. InitColumnThick(ColumnRec);
  1045. PreviewComXML.setActShowElementObj(SER);
  1046. end;
  1047. end;
  1048. end;
  1049. finally
  1050. ObjList.Free;
  1051. end;
  1052. end;
  1053. procedure InitContentAndGatherFont;
  1054. var
  1055. i, j: Integer;
  1056. ObjList: TList;
  1057. FlowContentRec : PContentRec;
  1058. CrossContentRec : PCrossContentRec;
  1059. SumRec : PSumRec;
  1060. begin
  1061. ObjList := TList.Create;
  1062. try
  1063. // 设置表正文
  1064. PreviewComXML.getAllFlowShowContentObjs(ObjList);
  1065. for i := 0 to ObjList.Count - 1 do
  1066. begin
  1067. FlowContentRec := ObjList[i];
  1068. if not (FlowContentRec.Fixed) then
  1069. begin
  1070. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1071. PreviewComXML.setFlowContentObj(FlowContentRec);
  1072. end;
  1073. end;
  1074. PreviewComXML.getAllBillShowContentObjs(ObjList);
  1075. for i := 0 to ObjList.Count - 1 do
  1076. begin
  1077. FlowContentRec := ObjList[i];
  1078. if not(FlowContentRec.Fixed) then
  1079. begin
  1080. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  1081. PreviewComXML.setBillContentObj(FlowContentRec);
  1082. end;
  1083. end;
  1084. PreviewComXML.getAllCrossContentObjs(ObjList);
  1085. for i := 0 to ObjList.Count - 1 do
  1086. begin
  1087. CrossContentRec := ObjList[i];
  1088. if not(CrossContentRec.CrossContent.Fixed) then
  1089. begin
  1090. AssignFontRec(CrossContentRec.CrossContent.FontRec, ReportConfig.ContentFont);
  1091. PreviewComXML.setCrossContentObj(CrossContentRec);
  1092. end;
  1093. end;
  1094. // 设置表合计
  1095. for i := 0 to 2 do
  1096. begin
  1097. PreviewComXML.getAllSumObjs(i,ObjList);
  1098. for j := 0 to ObjList.Count - 1 do
  1099. begin
  1100. SumRec := ObjList[j];
  1101. AssignFontRec(SumRec.FontRec, ReportConfig.GatherFont);
  1102. PreviewComXML.setSumObj(SumRec);
  1103. end;
  1104. end;
  1105. finally
  1106. ObjList.Free;
  1107. end;
  1108. end;
  1109. procedure InitGridHeaderFont;
  1110. var
  1111. i: Integer;
  1112. ObjList: TList;
  1113. HeadTailRec : PHeadRec;
  1114. begin
  1115. ObjList := TList.Create;
  1116. try
  1117. PreviewComXML.getAllHeadObjs(ObjList);
  1118. for i := 0 to ObjList.Count - 1 do
  1119. begin
  1120. HeadTailRec := ObjList[i];
  1121. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1122. PreviewComXML.setHeadTailObj(0, HeadTailRec);
  1123. end;
  1124. PreviewComXML.getAllTailObjs(ObjList);
  1125. for i := 0 to ObjList.Count - 1 do
  1126. begin
  1127. HeadTailRec := ObjList[i];
  1128. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  1129. PreviewComXML.setHeadTailObj(1, HeadTailRec);
  1130. end;
  1131. finally
  1132. ObjList.Free;
  1133. end;
  1134. end;
  1135. begin
  1136. InitTitleFont;
  1137. InitColumnFont;
  1138. InitContentAndGatherFont;
  1139. InitGridHeaderFont;
  1140. end;
  1141. procedure TReportsForm.PreviewComXMLGetDatasetEvent(
  1142. DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet);
  1143. begin
  1144. if DatasetInfo.ID = 0 then
  1145. ADataSet := MemoryReportManager.GetSqlResultDataSet(ReportTemplateManager.Current.InteractInfo.Sql, FProjectData)
  1146. else
  1147. ADataset := MemoryReportManager.GetMemoryDataSet(DatasetInfo.ID, FProjectData);
  1148. end;
  1149. function TReportsForm.GetIsExcel2010: Boolean;
  1150. begin
  1151. Result := chkExcel2010.Checked;
  1152. end;
  1153. procedure TReportsForm.InitFormView;
  1154. begin
  1155. rdbtnA3.Checked := SameText(rdbtnA3.Caption, ReportConfig.PageSize);
  1156. rdbtnA4.Checked := SameText(rdbtnA4.Caption, ReportConfig.PageSize);
  1157. SetPrinterPageSize(ReportConfig.PageSize);
  1158. end;
  1159. procedure TReportsForm.LoadExcelBorder(var Border: TColumnLineRec);
  1160. begin
  1161. Border.LeftThick := 0.5;
  1162. Border.TopThick := 0.5;
  1163. Border.RightThick := 0.5;
  1164. Border.BottomThick := 0.5;
  1165. if not ReportConfig.RepBorderVerLine then
  1166. begin
  1167. Border.LeftThick := 0;
  1168. Border.RightThick := 0;
  1169. end;
  1170. end;
  1171. procedure TReportsForm.PrintReport(ATemplateNode: TTemplateNode;
  1172. isPDF, isExcel: boolean; ExcelOutputName, TemplateFileName: string);
  1173. function CheckPrinterReady: Boolean;
  1174. var
  1175. PrinterHD: THandle;
  1176. NoJobs: Word;
  1177. s: LongWord;
  1178. Job_Info: Array[0..10] of Job_INFO_1;
  1179. cbNeeded: Cardinal;
  1180. cReturned: Cardinal;
  1181. ret: LongBool;
  1182. begin
  1183. if OpenPrinter(PChar(Printer.Printers[Printer.PrinterIndex]), PrinterHD, 0) then
  1184. begin
  1185. s := SizeOf(Job_Info);
  1186. cbNeeded := 0;
  1187. cReturned := 0;
  1188. NoJobs := 10;
  1189. ret := ENumJobs(PrinterHD, 0, NoJobs, 1, @Job_Info, s, cbNeeded, cReturned);
  1190. Result := not((cReturned > 0) and (Job_Info[0].TotalPages > 0));
  1191. end
  1192. else
  1193. Result := True;
  1194. end;
  1195. procedure PrintTemplet;
  1196. begin
  1197. if isPDF then
  1198. begin
  1199. PreviewComXML.PrintPDFAll;
  1200. while not CheckPrinterReady do
  1201. Sleep(1000);
  1202. end
  1203. else if not isExcel then
  1204. PreviewComXML.PrintAll(1)
  1205. else
  1206. ExportXlsReport(1, PreviewComXML.TotalPages, ExcelOutputName);
  1207. end;
  1208. var
  1209. strRptName : string;
  1210. begin
  1211. if not FileExists(ATemplateNode.FileName) then Exit;
  1212. ClearReportOprList;
  1213. ClearReportFuncList;
  1214. Screen.Cursor := crHourGlass;
  1215. try
  1216. LoadTemplet(ATemplateNode);
  1217. if PreviewComXML.TotalPages > 0 then
  1218. PrintTemplet
  1219. {else if strRptName <> '' then
  1220. begin
  1221. LoadTemplet(RptArchiverObj, strRptName);
  1222. PrintEmptyTemplet;
  1223. end;}
  1224. finally
  1225. Screen.Cursor := crDefault;
  1226. end;
  1227. end;
  1228. procedure TReportsForm.ExportXlsReport(AStartPage, AEndPage: Integer;
  1229. const AFileName: string);
  1230. procedure ExportPagesXlsReport(AStartPage, AEndPage: Integer; const AFileName: string);
  1231. var
  1232. Border : TColumnLineRec;
  1233. begin
  1234. LoadExcelBorder(Border);
  1235. if IsExcel2010 then
  1236. // 康博士代码中写批量打印是,用Printer.Canvas,打印当前时,用PreviewBox.Canvas。不懂为什么
  1237. PreViewComXML.OutputToExcelRangeXMLEx(PreviewBox.Canvas, AStartPage,
  1238. AEndPage, GetTemplateXlsFileName, AFileName, Border, ExcelMode)
  1239. else
  1240. PreViewComXML.OutputToExcelFile(PreviewBox.Canvas, AStartPage,
  1241. AEndPage, GetTemplateXlsFileName, AFileName, ExcelMode, Border);
  1242. end;
  1243. var
  1244. iStartPage, iEndPage, iCount: Integer;
  1245. sFileName: string;
  1246. begin
  1247. BeforeExport;
  1248. try
  1249. if (ExcelMode = oemNormal) and (PrintEndPage - PrintStartPage > 30) then
  1250. begin
  1251. iStartPage := PrintStartPage;
  1252. iEndPage := iStartPage + 19;
  1253. iCount := 1;
  1254. repeat
  1255. begin
  1256. sFileName := Format('%s[%d].xls', [ExtractSimpleFileName(AFileName), iCount]);
  1257. ExportPagesXlsReport(iStartPage, iEndPage, sFileName);
  1258. iStartPage := iStartPage + 20;
  1259. iEndPage := Min(iEndPage + 20, PrintEndPage);
  1260. Inc(iCount);
  1261. end
  1262. until iStartPage > iEndPage;
  1263. end
  1264. else
  1265. ExportPagesXlsReport(PrintStartPage, PrintEndPage, AFileName);
  1266. finally
  1267. AfterExport;
  1268. end;
  1269. end;
  1270. procedure TReportsForm.LoadTemplet(ATemplate: TTemplateNode);
  1271. var
  1272. RptArchiverObj: TReportArchiver;
  1273. Mem: TMemoryStream;
  1274. begin
  1275. RptArchiverObj := TReportArchiver.Create;
  1276. if ATemplate.IsMulti then
  1277. RptArchiverObj.FileName := ATemplate.MultiFileNames[FProjectData.PhaseIndex]
  1278. else
  1279. RptArchiverObj.FileName := ATemplate.FileName;
  1280. Mem := RptArchiverObj.Extract;
  1281. try
  1282. // 以下代码有顺序限制,不可修改,主要保证在不修改报表模板文件的基础上可以用户定制报表格式
  1283. // 私以为,原因在于这些设置修改后,并不能生效,需要保存再读取方可生效
  1284. // 读取报表模板
  1285. if not PreviewComXML.ReadReportStream(Mem) then Exit;
  1286. // 将报表设置中的数据覆盖掉原模板的数据
  1287. InitReportSettings(ATemplate);
  1288. // 保存
  1289. PreviewComXML.SaveToStream(Mem);
  1290. // 再次读取,使报表设置中的设置生效
  1291. PreviewComXML.ReadReportStream(Mem);
  1292. // ReadReportStream之后会将PreviewComXML的FillZero值赋为True,故再赋值一次
  1293. PreviewComXML.FillZero := chkFillZero.Checked;
  1294. PreviewComXML.ReadDBData;
  1295. PreviewComXML.AnalyseData;
  1296. finally
  1297. if Mem <> nil then
  1298. Mem.Free;
  1299. RptArchiverObj.Free;
  1300. end;
  1301. end;
  1302. function TReportsForm.GetHintStr: string;
  1303. begin
  1304. Result := #13#10 +
  1305. '对不起,学习版不提供报表打印、导出功能。'#13#10 +
  1306. #13#10 +
  1307. '以下为收费服务项目,请在必要时联系纵横:'#13#10 +
  1308. #13#10 +
  1309. '企业QQ:800003850 客服热线:(0756)3850888';
  1310. end;
  1311. function TReportsForm.GetSubClassNode(AClassNode: TExTreeNode;
  1312. ANode: TTemplateNode): TExTreeNode;
  1313. function FindNode(AParent: TExTreeNode; const AName: string): TExTreeNode;
  1314. var
  1315. I: Integer;
  1316. vNode: TExTreeNode;
  1317. begin
  1318. Result := nil;
  1319. if Assigned(AParent) then
  1320. vNode := AParent.getFirstChild
  1321. else
  1322. vNode := extvReport.Items.GetFirstNode;
  1323. while not Assigned(Result) and Assigned(vNode) do
  1324. begin
  1325. if SameText(vNode.Text, AName) then
  1326. Result := vNode;
  1327. vNode := vNode.getNextSibling;
  1328. end;
  1329. end;
  1330. begin
  1331. Result := FindNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1332. if not Assigned(Result) then
  1333. Result := AddClassNode(AClassNode, ANode.SubClassNum + '.' + ANode.SubClassName);
  1334. end;
  1335. function TReportsForm.AddClassNode(AParent: TExTreeNode;
  1336. const AName: string): TExTreeNode;
  1337. begin
  1338. Result := extvReport.Items.AddChildObject(AParent, AName, Pointer(nil));
  1339. Result.ImageIndex := 0;
  1340. Result.SelectedIndex := 1;
  1341. Result.Checked := csUnchecked;
  1342. Result.Expanded := True;
  1343. end;
  1344. procedure TReportsForm.SaveReportInteractData(ATemplate: TTemplateNode);
  1345. begin
  1346. case ATemplate.InteractFlag of
  1347. 1: SaveAuditOpinion(ATemplate);
  1348. end;
  1349. end;
  1350. procedure TReportsForm.SaveAuditOpinion(ATemplate: TTemplateNode);
  1351. var
  1352. SelectForm: TAuditSelctForm;
  1353. begin
  1354. SelectForm := TAuditSelctForm.Create(FProjectData, ATemplate);
  1355. try
  1356. if SelectForm.ShowModal = mrOk then
  1357. SelectForm.SaveAuditData;
  1358. finally
  1359. SelectForm.Free;
  1360. end;
  1361. end;
  1362. destructor TReportsForm.Destroy;
  1363. begin
  1364. FReportDataPrepare.Free;
  1365. inherited;
  1366. end;
  1367. end.