ReportsFrm.pas 45 KB

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