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;
  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(const ATempletName: string);
  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;
  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. if vTemplateNode.IsMulti then
  262. LoadTemplet(vTemplateNode.MultiFileNames[FProjectData.PhaseIndex])
  263. else
  264. LoadTemplet(vTemplateNode.FileName);
  265. if PreviewComXML.TotalPages > 0 then
  266. PreviewTemplet
  267. else
  268. LoadEmptyTempletAndDisplay;
  269. finally
  270. Screen.Cursor := crDefault;
  271. end;
  272. end;
  273. procedure TReportsForm.SetProjectData(const Value: TProjectData);
  274. begin
  275. FProjectData := Value;
  276. FReportDataPrepare := TReportPrepare.Create(FProjectData);
  277. extvReport.Selected := extvReport.Items[0];
  278. LoadReportTemplets;
  279. LoadTempletAndDisplay;
  280. end;
  281. procedure TReportsForm.PreviewComXMLGetDataConnection(
  282. var ADOCon: TADOConnection);
  283. begin
  284. ADOCon := FProjectData.ADOConnection;
  285. end;
  286. procedure TReportsForm.PreviewReportCurPage;
  287. begin
  288. if FbNormal then
  289. PreviewComXML.PrintPreviewCanvas(-1, PrecededCount, PreviewBox.Canvas)
  290. else //强制1:1显示
  291. PreviewComXML.PrintPreviewCanvas(CurPage, 0, PreviewBox.Canvas);
  292. end;
  293. procedure TReportsForm.ResizePreviewBox;
  294. var
  295. iHeight, iWidth: Integer;
  296. begin
  297. if FbNormal then
  298. begin
  299. iHeight := sbReportsPreview.ClientHeight;
  300. iWidth := sbReportsPreview.ClientWidth;
  301. end
  302. else
  303. begin
  304. iHeight := Max(PreviewComXML.PrintHeight + 20, sbReportsPreview.ClientHeight);
  305. iWidth := Max(PreviewComXML.PrintWidth + 20, sbReportsPreview.ClientWidth);
  306. end;
  307. if PreviewBox.Height <> iHeight then
  308. begin
  309. PreviewBox.Height := iHeight;
  310. PreviewBox.Picture.Bitmap.Height := iHeight;
  311. end;
  312. if PreviewBox.Width <> iWidth then
  313. begin
  314. PreviewBox.Width := iWidth;
  315. PreviewBox.Picture.Bitmap.Width := iWidth;
  316. end;
  317. end;
  318. procedure TReportsForm.RepaintCurPagePreview;
  319. begin
  320. ResizePreviewBox;
  321. PreviewReportCurPage;
  322. end;
  323. procedure TReportsForm.xlbRealSizeClick(Sender: TObject);
  324. begin
  325. FbNormal := False;
  326. DisplayCount := TdxBarLargeButton(Sender).Tag;
  327. RepaintCurPagePreview;
  328. end;
  329. procedure TReportsForm.xlbOnePageClick(Sender: TObject);
  330. begin
  331. PreviewComXML.PreviewRows := 1;
  332. PreviewComXML.PreviewCols := 1;
  333. DisplayCount := TdxBarLargeButton(Sender).Tag;
  334. FbNormal := True;
  335. RepaintCurPagePreview;
  336. end;
  337. procedure TReportsForm.xlbTwoPageClick(Sender: TObject);
  338. begin
  339. if PreviewComXML.ReportSize.X > PreviewComXML.ReportSize.Y then
  340. begin
  341. PreviewComXML.PreviewRows := 2;
  342. PreviewComXML.PreviewCols := 1;
  343. end
  344. else
  345. begin
  346. PreviewComXML.PreviewRows := 1;
  347. PreviewComXML.PreviewCols := 2;
  348. end;
  349. DisplayCount := TdxBarLargeButton(Sender).Tag;
  350. FbNormal := true;
  351. RepaintCurPagePreview;
  352. end;
  353. procedure TReportsForm.xlbFourPageClick(Sender: TObject);
  354. begin
  355. PreviewComXML.PreviewRows := 2;
  356. PreviewComXML.PreviewCols := 2;
  357. DisplayCount := TdxBarLargeButton(Sender).Tag;
  358. FbNormal := true;
  359. RepaintCurPagePreview;
  360. end;
  361. procedure TReportsForm.xlbFirstPageClick(Sender: TObject);
  362. begin
  363. CurPage := 1;
  364. end;
  365. procedure TReportsForm.SetCurPage(const Value: Integer);
  366. begin
  367. if (Value < 0) or (Value > PageCount) then Exit;
  368. FCurPage := Value;
  369. xcbPages.Text := IntToStr(FCurPage);
  370. //PreviewComXML.FillZero := chkFillZero.Checked;
  371. PreviewReportCurPage;
  372. end;
  373. function TReportsForm.GetPrintEndPage: Integer;
  374. begin
  375. Result := StrToIntDef(xcbEndPage.Text, 0);
  376. end;
  377. function TReportsForm.GetPrintStartPage: Integer;
  378. begin
  379. Result := StrToIntDef(xcbStartPage.Text, 0);
  380. end;
  381. function TReportsForm.GetPageCount: Integer;
  382. begin
  383. Result := PreviewComXML.TotalPages;
  384. end;
  385. function TReportsForm.GetPrecededCount: Integer;
  386. begin
  387. Result := (CurPage + (DisplayCount - 1)) div DisplayCount;
  388. end;
  389. procedure TReportsForm.xlbPrePageClick(Sender: TObject);
  390. begin
  391. if CurPage > 1 then
  392. CurPage := CurPage - 1;
  393. end;
  394. procedure TReportsForm.xlbNextPageClick(Sender: TObject);
  395. begin
  396. if CurPage < PageCount then
  397. CurPage := CurPage + 1;
  398. end;
  399. procedure TReportsForm.xlbLastPageClick(Sender: TObject);
  400. begin
  401. CurPage := PageCount;
  402. end;
  403. procedure TReportsForm.xcbPagesChange(Sender: TObject);
  404. begin
  405. if (StrToIntDef(xcbPages.Text, 0) > 0) and
  406. (StrToIntDef(xcbPages.Text, 0) <= PageCount) then
  407. CurPage := StrToIntDef(xcbPages.Text, 0)
  408. else
  409. xcbPages.Text := IntToStr(CurPage);
  410. end;
  411. procedure TReportsForm.xlbPrintCurPageClick(Sender: TObject);
  412. begin
  413. if _IsEncrypt or G_IsCloud then
  414. PreviewComXML.Print(CurPage, 1)
  415. else
  416. TipMessage(GetHintStr, Handle);
  417. end;
  418. procedure TReportsForm.xcbStartPageChange(Sender: TObject);
  419. begin
  420. if (StrToIntDef(TdxBarCombo(Sender).Text, 0) > 0) and
  421. (StrToIntDef(TdxBarCombo(Sender).Text, 0) <= PageCount) then
  422. TdxBarCombo(Sender).Tag := StrToIntDef(TdxBarCombo(Sender).Text, 0)
  423. else
  424. TdxBarCombo(Sender).Text := IntToStr(TdxBarCombo(Sender).Tag);
  425. end;
  426. procedure TReportsForm.xlbPrintClick(Sender: TObject);
  427. begin
  428. if _IsEncrypt or G_IsCloud then
  429. begin
  430. if extvReport.LeafCheckedCount > 0 then
  431. PrintAllSelectedReports
  432. else
  433. PreviewComXML.PrintMultiPages(PrintStartPage, PrintEndPage);
  434. end
  435. else
  436. TipMessage(GetHintStr, Handle);
  437. end;
  438. procedure TReportsForm.PrintAllSelectedReports;
  439. var
  440. iIndex: Integer;
  441. Node: TExTreeNode;
  442. vTemplateNode: TTemplateNode;
  443. begin
  444. for iIndex := 0 to extvReport.Items.Count - 1 do
  445. begin
  446. Node := extvReport.Items[iIndex];
  447. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  448. vTemplateNode := TTemplateNode(Node.Data);
  449. if FileExists(vTemplateNode.FileName) then
  450. directPrintReport(PreviewBox.Canvas, vTemplateNode.FileName,
  451. PreviewComXML, False, False, oemNormal,'','', IsExcel2010);
  452. end;
  453. extvReport.ClearChecked;
  454. end;
  455. procedure TReportsForm.xlbToPDFClick(Sender: TObject);
  456. begin
  457. if _IsEncrypt or G_IsCloud then
  458. begin
  459. if extvReport.LeafCheckedCount > 0 then
  460. ExportAllSelectedPDFReports
  461. else
  462. PreviewComXML.PrintPDF(PrintStartPage, PrintEndPage);
  463. end
  464. else
  465. TipMessage(GetHintStr, Handle);
  466. end;
  467. procedure TReportsForm.ExportAllSelectedPDFReports;
  468. var
  469. iIndex: Integer;
  470. Node: TExTreeNode;
  471. vTemplateNode: TTemplateNode;
  472. begin
  473. for iIndex := 0 to extvReport.Items.Count - 1 do
  474. begin
  475. Node := extvReport.Items[iIndex];
  476. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  477. vTemplateNode := TTemplateNode(Node.Data);
  478. if FileExists(vTemplateNode.FileName) then
  479. PrintReport(vTemplateNode, True, False,'','');
  480. end;
  481. extvReport.ClearChecked;
  482. end;
  483. procedure TReportsForm.xlbToExcelClick(Sender: TObject);
  484. begin
  485. if _IsEncrypt or G_IsCloud then
  486. begin
  487. if extvReport.LeafCheckedCount > 0 then
  488. ExportAllSelectedXlsReports
  489. else
  490. ExportCurXlsReport;
  491. end
  492. else
  493. TipMessage(GetHintStr, Handle);
  494. end;
  495. procedure TReportsForm.ExportAllSelectedXlsReports;
  496. var
  497. iIndex: Integer;
  498. Node: TExTreeNode;
  499. vTemplateNode: TTemplateNode;
  500. sPath, sOutputFileName: String;
  501. begin
  502. if BrowseFolder(sPath, '请选择导出报表路径', Handle) then
  503. begin
  504. for iIndex := 0 to extvReport.Items.Count - 1 do
  505. begin
  506. Node := extvReport.Items[iIndex];
  507. if Node.HasChildren or (Node.Checked <> csChecked) or (Node.Data = nil) then Continue;
  508. vTemplateNode := TTemplateNode(Node.Data);
  509. sOutputFileName := sPath + ExtractSimpleFileName(vTemplateNode.FileName) + '.xls';
  510. if FileExists(vTemplateNode.FileName) then
  511. PrintReport(vTemplateNode, False, True, sOutputFileName, GetTemplateXlsFileName);
  512. end;
  513. extvReport.ClearChecked;
  514. end;
  515. end;
  516. procedure TReportsForm.ExportCurXlsReport;
  517. var
  518. sFileName: string;
  519. begin
  520. sFileName := extvReport.Selected.Text;
  521. if (PrintStartPage <= PrintEndPage) and SaveFile(sFileName, '.xls') then
  522. ExportXlsReport(PrintStartPage, PrintEndPage, sFileName);
  523. end;
  524. procedure TReportsForm.AfterExport;
  525. begin
  526. // ToDo - 关闭进度条
  527. // ToDo - 取消设置Update进度条事件
  528. // PreviewComXML.OnProgress := nil;
  529. Screen.Cursor := crDefault;
  530. end;
  531. procedure TReportsForm.BeforeExport;
  532. begin
  533. Screen.Cursor := crHourGlass;
  534. // ToDo - 设置Update进度条事件
  535. // PreviewComXML.OnProgress := PreviewComXMLProgress;
  536. // ToDo - 打开进度条
  537. end;
  538. function TReportsForm.GetExcelMode: TOutputExcelMode;
  539. begin
  540. if chkExcelMode.Checked then
  541. Result := oemOneSheet
  542. else
  543. Result := oemNormal;
  544. end;
  545. procedure TReportsForm.extvReportClick(Sender: TObject);
  546. begin
  547. LoadTempletAndDisplay;
  548. end;
  549. procedure TReportsForm.xlbCloseClick(Sender: TObject);
  550. begin
  551. Close;
  552. end;
  553. procedure TReportsForm.AddReportTemplate(ANode: TTemplateNode);
  554. var
  555. vClassNode, vNode: TExTreeNode;
  556. begin
  557. vClassNode := GetClassNode(ANode);
  558. if ANode.SubClassNum <> '' then
  559. vClassNode := GetSubClassNode(vClassNode, ANode);
  560. vNode := extvReport.Items.AddChildObject(vClassNode, ANode.TemplateName, Pointer(ANode));
  561. vNode.ImageIndex := 2;
  562. vNode.SelectedIndex := 3;
  563. vNode.Checked := csUnchecked;
  564. if (vClassNode <> nil) and not vClassNode.Expanded then
  565. vClassNode.Expanded := True;
  566. end;
  567. function TReportsForm.GetClassNode(ANode: TTemplateNode): TExTreeNode;
  568. function FindClassNode(const AName: string): TExTreeNode;
  569. var
  570. I: Integer;
  571. vNode: TExTreeNode;
  572. begin
  573. Result := nil;
  574. for I := 0 to extvReport.Items.Count - 1 do
  575. begin
  576. vNode := extvReport.Items.Item[I];
  577. if SameText(vNode.Text, AName) then
  578. begin
  579. Result := vNode;
  580. Break;
  581. end;
  582. end;
  583. end;
  584. begin
  585. Result := FindClassNode(ANode.ClassNum + '.' + ANode.ClassName);
  586. if not Assigned(Result) then
  587. Result := AddClassNode(nil, ANode.ClassNum + '.' + ANode.ClassName);
  588. end;
  589. procedure TReportsForm.tbImportSrtClick(Sender: TObject);
  590. procedure ImportReportTemplate(const AFileName: string);
  591. var
  592. sNewFileName: string;
  593. vTemplateNode: TTemplateNode;
  594. begin
  595. sNewFileName := GetReportTemplatePath + ExtractFileName(AFileName);
  596. if not FileExists(sNewFileName) then
  597. begin
  598. CopyFile(PChar(AFileName), PChar(sNewFileName), True);
  599. vTemplateNode := ReportTemplateManager.AddReportTemplate(sNewFileName);
  600. AddReportTemplate(vTemplateNode);
  601. end
  602. else
  603. if QuestMessage('已存在报表模板' + ExtractFileName(AFileName) + ',是否覆盖原模板?', Handle) then
  604. CopyFile(PChar(AFileName), PChar(sNewFileName), False)
  605. else
  606. Exit;
  607. end;
  608. var
  609. sgsFiles: TStrings;
  610. iFile: Integer;
  611. begin
  612. sgsFiles := TStringList.Create;
  613. try
  614. if SelectFiles(sgsFiles, '.srt') then
  615. begin
  616. for iFile := 0 to sgsFiles.Count - 1 do
  617. ImportReportTemplate(sgsFiles.Strings[iFile]);
  618. end;
  619. finally
  620. sgsFiles.Free;
  621. end;
  622. end;
  623. procedure TReportsForm.tbDeleteSrtClick(Sender: TObject);
  624. var
  625. vTemplateNode: TTemplateNode;
  626. begin
  627. if not Assigned(extvReport.Selected) then Exit;
  628. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  629. if not Assigned(vTemplateNode) then Exit;
  630. extvReport.Items.Delete(extvReport.Selected);
  631. DeleteFile(vTemplateNode.FileName);
  632. ReportTemplateManager.DeleteReportTemplate(vTemplateNode);
  633. LoadTempletAndDisplay;
  634. end;
  635. procedure TReportsForm.tbExportSrtClick(Sender: TObject);
  636. var
  637. vTemplateNode: TTemplateNode;
  638. sFileName: string;
  639. begin
  640. if not Assigned(extvReport.Selected) then Exit;
  641. vTemplateNode := TTemplateNode(extvReport.Selected.Data);
  642. if not Assigned(vTemplateNode) then Exit;
  643. sFileName := vTemplateNode.TemplateName;
  644. if SaveFile(sFileName, '.srt') then
  645. begin
  646. if not FileExists(sFileName) or QuestMessage('存在同名文件,是否覆盖?', Handle) then
  647. CopyFile(PChar(vTemplateNode.FileName), PChar(sFileName), False);
  648. end;
  649. end;
  650. procedure TReportsForm.PreviewComXMLContentDisplay(
  651. var contentFontRec: TFontRec; dataType: Integer; isReading: Boolean;
  652. DrawType: Integer; isPrinting: Boolean);
  653. begin
  654. if ReportConfig.ContentIsNarrow then
  655. begin
  656. if (isReading) then
  657. begin
  658. begin
  659. contentFontRec.FontName := 'Arial Narrow';
  660. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  661. end;
  662. end else
  663. begin
  664. if (DrawType = 3) or (DrawType = 5) then
  665. begin
  666. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  667. end else if (isPrinting) then
  668. begin
  669. contentFontRec.FontName := 'Arial Narrow';
  670. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 7 div 6;
  671. end else
  672. begin
  673. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  674. end;
  675. end;
  676. end;
  677. end;
  678. procedure TReportsForm.xlbSetupClick(Sender: TObject);
  679. begin
  680. if AdjustReport then
  681. LoadTempletAndDisplay;
  682. end;
  683. procedure TReportsForm.InitReportSettings;
  684. begin
  685. PreviewComXML.FillZero := chkFillZero.Checked;
  686. InitPageSettings;
  687. InitPaperSettings;
  688. end;
  689. procedure TReportsForm.InitPageSettings;
  690. begin
  691. // 设置页面大小
  692. PreviewComXML.setPageSize(ReportConfig.PageSize);
  693. // 设置边距
  694. PreviewComXML.setEdge(0, '', ReportConfig.LeftEdge/10);
  695. PreviewComXML.setEdge(1, '', ReportConfig.RightEdge/10);
  696. PreviewComXML.setEdge(2, '', ReportConfig.UpEdge/10);
  697. PreviewComXML.setEdge(3, '', ReportConfig.DownEdge/10);
  698. end;
  699. procedure TReportsForm.InitPaperSettings;
  700. procedure InitRepBorderLine;
  701. var
  702. i: Integer;
  703. ObjList : TList;
  704. ShapeRec : PPicRec;
  705. begin
  706. ObjList := TList.Create;
  707. try
  708. PreviewComXML.getAllShapeObjs(1, ObjList);
  709. for i := 0 to ObjList.Count - 1 do
  710. begin
  711. ShapeRec := ObjList[i];
  712. // 设置报表边框线粗
  713. ShapeRec.PenWidth := ReportConfig.BorderLine;
  714. // 设置是否绘制报表边框横线
  715. if (ShapeRec.ExArea.ExLeft <> ShapeRec.ExArea.ExRight) then
  716. begin
  717. if not ReportConfig.RepBorderUnderLine then
  718. ShapeRec.PenStyle := integer(psClear)
  719. else
  720. ShapeRec.PenStyle := integer(psSolid);
  721. end;
  722. // 设置是否绘制报表边框竖线
  723. if (ShapeRec.ExArea.ExTop <> ShapeRec.ExArea.ExBottom) and
  724. ((ShapeRec.ExArea.ExLeft = 0) or (ShapeRec.ExArea.ExLeft = 100)) then
  725. begin //这里的判断条件是约定好的
  726. if not ReportConfig.RepBorderVerLine then
  727. ShapeRec.PenStyle := integer(psClear)
  728. else
  729. ShapeRec.PenStyle := integer(psSolid)
  730. end;
  731. PreviewComXML.setShapeObj(ShapeRec);
  732. end;
  733. finally
  734. ObjList.Free;
  735. end;
  736. end;
  737. procedure InitRepCellLine;
  738. var
  739. i: Integer;
  740. ObjList : TList;
  741. ColumnRec : PColumnRec;
  742. FlowContentRec : PContentRec;
  743. CrossContentRec : PCrossContentRec;
  744. begin
  745. ObjList := TList.Create;
  746. try
  747. PreviewComXML.getAllFlowShowContentObjs(ObjList);
  748. // 设置报表表格横线
  749. for i := 0 to ObjList.Count - 1 do
  750. begin
  751. FlowContentRec := ObjList[i];
  752. FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  753. FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  754. PreviewComXML.setFlowContentObj(FlowContentRec);
  755. end;
  756. PreviewComXML.getAllCrossContentObjs(ObjList);
  757. for i := 0 to ObjList.Count - 1 do
  758. begin
  759. CrossContentRec := ObjList[i];
  760. CrossContentRec.CrossContent.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  761. CrossContentRec.CrossContent.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  762. PreviewComXML.setCrossContentObj(CrossContentRec);
  763. end;
  764. // 设置报表表格竖线
  765. PreviewComXML.getAllFlowShowContentObjs(ObjList);
  766. for i := 0 to ObjList.Count - 1 do
  767. begin
  768. FlowContentRec := ObjList[i];
  769. FlowContentRec.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  770. FlowContentRec.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  771. // 如果设置无表格边框线,则两端的表格竖线线粗为0
  772. if (not ReportConfig.RepBorderVerLine) then
  773. if (i = 0) then
  774. FlowContentRec.LineInfo.LeftThick := 0
  775. else if (i = ObjList.Count - 1) then
  776. FlowContentRec.LineInfo.RightThick := 0;
  777. PreviewComXML.setFlowContentObj(FlowContentRec);
  778. end;
  779. PreviewComXML.getAllCrossContentObjs(ObjList);
  780. for i := 0 to ObjList.Count - 1 do
  781. begin
  782. CrossContentRec := ObjList[i];
  783. CrossContentRec.CrossContent.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  784. CrossContentRec.CrossContent.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  785. ColumnRec := CrossContentRec.CrossContent.Column;
  786. //这里还要判断如果没有边框竖线的情况下,表格竖线边缘的线粗也为0
  787. //前提是所属表栏最右位置位于边缘
  788. if (not ReportConfig.RepBorderVerLine) and (ColumnRec<>nil) and
  789. ((ColumnRec.ExArea.ExRight = 100.0) or (ColumnRec.ExArea.ExLeft = 0.0)) then
  790. begin
  791. case CrossContentRec.CrossType of
  792. 0 : //交叉行
  793. begin
  794. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  795. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  796. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  797. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  798. end;
  799. 1 : //交叉列
  800. begin
  801. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  802. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  803. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  804. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  805. //(*
  806. if (CrossContentRec.CrossContent.isSpecialBorder) then
  807. begin
  808. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  809. CrossContentRec.CrossContent.SpecialLineInfo.RightThick := 0;
  810. end;
  811. //*)
  812. end;
  813. 2 : //显示数据
  814. begin
  815. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  816. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  817. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  818. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  819. end;
  820. 3 : //固定LABEL
  821. begin
  822. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  823. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  824. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  825. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  826. end;
  827. 4 : //序号
  828. begin
  829. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  830. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  831. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  832. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  833. end;
  834. 5 : //横向统计
  835. begin
  836. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  837. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  838. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  839. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  840. end;
  841. end;
  842. end;
  843. PreviewComXML.setCrossContentObj(CrossContentRec);
  844. end;
  845. finally
  846. ObjList.Free;
  847. end;
  848. end;
  849. procedure InitOtherArea;
  850. procedure SetPTRBorder(PTR : PTextRec);
  851. procedure SetLeftRightBorder;
  852. begin
  853. if PTR.ExArea.ExLeft = 0.0 then
  854. begin
  855. if BorderWidth = 0.0 then
  856. PTR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth;
  857. end;
  858. if PTR.ExArea.ExRight = 100.0 then
  859. begin
  860. if BorderWidth = 0.0 then
  861. PTR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth
  862. end;
  863. end;
  864. procedure SetHorLine;
  865. begin
  866. if (PTR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  867. PTR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  868. if (PTR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  869. PTR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  870. end;
  871. begin
  872. SetLeftRightBorder;
  873. SetHorLine;
  874. end;
  875. procedure SetPCRBorder(PCR : PColumnRec);
  876. procedure SetLeftRightBorder;
  877. begin
  878. if PCR.ExArea.ExLeft = 0.0 then
  879. begin
  880. if BorderWidth = 0.0 then
  881. PCR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth
  882. end;
  883. if PCR.ExArea.ExRight = 100.0 then
  884. begin
  885. if BorderWidth = 0.0 then
  886. PCR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth;
  887. end;
  888. end;
  889. procedure SetVerLine;
  890. begin
  891. if PCR.ExArea.ExLeft = 0.0 then
  892. PCR.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  893. if PCR.ExArea.ExRight = 100.0 then
  894. PCR.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  895. end;
  896. procedure SetHorLine;
  897. begin
  898. if (PCR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  899. PCR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  900. if (PCR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  901. PCR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  902. end;
  903. begin
  904. SetLeftRightBorder;
  905. SetVerLine;
  906. SetHorLine;
  907. end;
  908. var i,k : integer;
  909. ObjList : TList;
  910. ActAreaRec : PActiveAreaRec;
  911. PSR : PShowElementRec;
  912. begin
  913. ObjList := TList.Create;
  914. try
  915. ActAreaRec := nil;
  916. PreviewComXML.getAllActAreaObjs(ObjList);
  917. for i := 0 to ObjList.Count - 1 do
  918. begin
  919. ActAreaRec := ObjList[i];
  920. if (ActAreaRec.ShowType < 0) or (ActAreaRec.ShowType > 2) then Continue;
  921. if not Assigned(ActAreaRec.ElementList) then Continue;
  922. for k := 0 to ActAreaRec.ElementList.Count - 1 do
  923. begin
  924. PSR := PShowElementRec(ActAreaRec.ElementList[k]);
  925. case PSR.ElementType of
  926. 0..2 : SetPTRBorder(PSR.Data); //文本,参数,字段,表栏
  927. 7 : SetPCRBorder(PSR.Data) //Column
  928. end;
  929. PreviewComXML.setActShowElementObj(PSR);
  930. end;
  931. end;
  932. finally
  933. ObjList.Free;
  934. end;
  935. end;
  936. begin
  937. InitFont; // 各类字体
  938. InitRepBorderLine; // 报表边框
  939. InitRepCellLine; // 报表表格
  940. InitOtherArea; // 活动区域
  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. if ATemplateNode.IsMulti then
  1230. LoadTemplet(ATemplateNode.MultiFileNames[FProjectData.PhaseIndex])
  1231. else
  1232. LoadTemplet(ATemplateNode.FileName);
  1233. if PreviewComXML.TotalPages > 0 then
  1234. PrintTemplet
  1235. {else if strRptName <> '' then
  1236. begin
  1237. LoadTemplet(RptArchiverObj, strRptName);
  1238. PrintEmptyTemplet;
  1239. end;}
  1240. finally
  1241. Screen.Cursor := crDefault;
  1242. end;
  1243. end;
  1244. procedure TReportsForm.ExportXlsReport(AStartPage, AEndPage: Integer;
  1245. const AFileName: string);
  1246. procedure ExportPagesXlsReport(AStartPage, AEndPage: Integer; const AFileName: string);
  1247. var
  1248. Border : TColumnLineRec;
  1249. begin
  1250. LoadExcelBorder(Border);
  1251. if IsExcel2010 then
  1252. // 康博士代码中写批量打印是,用Printer.Canvas,打印当前时,用PreviewBox.Canvas。不懂为什么
  1253. PreViewComXML.OutputToExcelRangeXMLEx(PreviewBox.Canvas, AStartPage,
  1254. AEndPage, GetTemplateXlsFileName, AFileName, Border, ExcelMode)
  1255. else
  1256. PreViewComXML.OutputToExcelFile(PreviewBox.Canvas, AStartPage,
  1257. AEndPage, GetTemplateXlsFileName, AFileName, ExcelMode, Border);
  1258. end;
  1259. var
  1260. iStartPage, iEndPage, iCount: Integer;
  1261. sFileName: string;
  1262. begin
  1263. BeforeExport;
  1264. try
  1265. if (ExcelMode = oemNormal) and (PrintEndPage - PrintStartPage > 30) then
  1266. begin
  1267. iStartPage := PrintStartPage;
  1268. iEndPage := iStartPage + 19;
  1269. iCount := 1;
  1270. repeat
  1271. begin
  1272. sFileName := Format('%s[%d].xls', [ExtractSimpleFileName(AFileName), iCount]);
  1273. ExportPagesXlsReport(iStartPage, iEndPage, sFileName);
  1274. iStartPage := iStartPage + 20;
  1275. iEndPage := Min(iEndPage + 20, PrintEndPage);
  1276. Inc(iCount);
  1277. end
  1278. until iStartPage > iEndPage;
  1279. end
  1280. else
  1281. ExportPagesXlsReport(PrintStartPage, PrintEndPage, AFileName);
  1282. finally
  1283. AfterExport;
  1284. end;
  1285. end;
  1286. procedure TReportsForm.LoadTemplet(const ATempletName: string);
  1287. var
  1288. RptArchiverObj: TReportArchiver;
  1289. Mem: TMemoryStream;
  1290. begin
  1291. RptArchiverObj := TReportArchiver.Create;
  1292. RptArchiverObj.FileName := ATempletName;
  1293. Mem := RptArchiverObj.Extract;
  1294. try
  1295. // 以下代码有顺序限制,不可修改,主要保证在不修改报表模板文件的基础上可以用户定制报表格式
  1296. // 私以为,原因在于这些设置修改后,并不能生效,需要保存再读取方可生效
  1297. // 读取报表模板
  1298. if not PreviewComXML.ReadReportStream(Mem) then Exit;
  1299. // 将报表设置中的数据覆盖掉原模板的数据
  1300. InitReportSettings;
  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.