ReportsFrm.pas 49 KB

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