SignOnlineReportsFrm.pas 42 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352
  1. unit SignOnlineReportsFrm;
  2. interface
  3. uses
  4. ProjectData, ReportManager, ReportConnection, ReportPrepare,
  5. PrintComTypeDefUnit, ADODB, DB, SignReports,
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, sdIDTree, sdDB, ComCtrls, ExtCtrls, VirtualTrees, PrintCom,
  8. PrintComXML, MScrollBox, StdCtrls, Buttons, PNGButton, ieview,
  9. imageenview, jpeg;
  10. const
  11. crNext = -25;
  12. crPrevious = -26;
  13. offset = 150;
  14. type
  15. TUploadType = (utSign, utEpure);
  16. TSignOnlineReportsForm = class(TForm)
  17. tvReports: TTreeView;
  18. pnlBottom: TPanel;
  19. PreviewComXML: TPrintComXML;
  20. previewBox: TImage;
  21. msbReportsPreview: TMScrollBox;
  22. lblAlreadyUpload: TLabel;
  23. cbFillZero: TCheckBox;
  24. pnlPageControl: TPanel;
  25. btnPre: TButton;
  26. btnNext: TButton;
  27. lblPages: TLabel;
  28. pbGenerate: TPNGButton;
  29. ImageEnView1: TImageEnView;
  30. lblEpureHint: TLabel;
  31. procedure FormShow(Sender: TObject);
  32. procedure tvReportsClick(Sender: TObject);
  33. procedure PreviewComXMLContentDisplay(var contentFontRec: TFontRec;
  34. dataType: Integer; isReading: Boolean; DrawType: Integer;
  35. isPrinting: Boolean);
  36. procedure PreviewComXMLCrossTabLabelShow(valIDX: Integer; var ExLeft,
  37. ExRight: Double; var isShow: Boolean; CrsTabShowType: Integer);
  38. procedure PreviewComXMLGetDataConnection(var ADOCon: TADOConnection);
  39. procedure PreviewComXMLGetDatasetEvent(DatasetInfo: PDatasetInfoRec;
  40. var ADataset: TDataSet);
  41. procedure msbReportsPreviewMouseWheelDown(Sender: TObject;
  42. Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  43. procedure msbReportsPreviewMouseWheelUp(Sender: TObject;
  44. Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  45. procedure ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
  46. MousePos: TPoint; var Handled: Boolean);
  47. procedure ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
  48. MousePos: TPoint; var Handled: Boolean);
  49. procedure btnPreClick(Sender: TObject);
  50. procedure btnNextClick(Sender: TObject);
  51. procedure pbGenerateClick(Sender: TObject);
  52. procedure cbFillZeroClick(Sender: TObject);
  53. private
  54. FWebProjectID: Integer;
  55. FWebTenderID: Integer;
  56. FSignPhase: Integer;
  57. FProjectData: TProjectData;
  58. // 数据库管理
  59. FReportCon: TReportConnection;
  60. // 报表数据准备
  61. FReportDataPrepare: TReportPrepare;
  62. FPreviewList: TList;
  63. FCurPage: Integer;
  64. FTempPath: string;
  65. FUploadType: TUploadType;
  66. FLoadListUrl: string;
  67. FPostedSignReports: TSignReports;
  68. procedure OnViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  69. procedure OnViewMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  70. function SafeReportName(var AName: string): Boolean;
  71. procedure ExportReportPage(APage: Integer; const APageFileName: string);
  72. procedure ExportReports(const AFileName: string);
  73. procedure ExportPdfReports(const AFileName: string);
  74. procedure GenerateSignReport;
  75. procedure GenerateEpureReport;
  76. procedure LoadReportTemplates;
  77. procedure PreviewPage(AImage: TImage; APageIndex: Integer);
  78. procedure InitPageSettings(APrintCom: TPrintComXML);
  79. procedure InitFont(APrintCom: TPrintComXML);
  80. procedure InitPaperSettings(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  81. procedure InitReportSettings(APrintCom: TPrintComXML; ATemplate: TTemplateNode = nil);
  82. procedure SaveAuditOpinion(ATemplate: TTemplateNode);
  83. procedure SaveReportInteractData(ATemplate: TTemplateNode);
  84. procedure LoadTemplet(ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  85. procedure LoadTemplateAndDisplay(ATemplate: TTemplateNode);
  86. procedure SetCurPage(const Value: Integer);
  87. public
  88. constructor Create(AOwner: TComponent); override;
  89. destructor Destroy; override;
  90. procedure Init(AProjNode: TsdIDTreeNode; ASignPhase: Integer);
  91. // 特性初始化
  92. procedure InitForSign;
  93. procedure InitForEpure;
  94. property ProjectData: TProjectData read FProjectData;
  95. property CurPage: Integer read FCurPage write SetCurPage;
  96. end;
  97. // 在线签署
  98. procedure SignOnline(AProjectNode: TsdIDTreeNode; ASignPhase: Integer);
  99. // 插入计量草图(中间计量)
  100. procedure EpureOnline(AProjectNode: TsdIDTreeNode; AEpurePhase: Integer);
  101. implementation
  102. uses
  103. UtilMethods, TemplateManagerHelper, Globals, AuditSelectFrm,
  104. ScFileArchiver, ZhAPI, PHPWebDm, imageenio, ReportPdfHelper,
  105. mProgressFrm, RenameSignReportFrm, Math, superobject, ProgressHintFrm;
  106. {$R *.dfm}
  107. procedure SignOnline(AProjectNode: TsdIDTreeNode; ASignPhase: Integer);
  108. var
  109. vSignForm: TSignOnlineReportsForm;
  110. begin
  111. vSignForm := TSignOnlineReportsForm.Create(nil);
  112. try
  113. vSignForm.Init(AProjectNode, ASignPhase);
  114. vSignForm.InitForSign;
  115. vSignForm.ShowModal;
  116. finally
  117. vSignForm.Free;
  118. end;
  119. end;
  120. procedure EpureOnline(AProjectNode: TsdIDTreeNode; AEpurePhase: Integer);
  121. var
  122. vEpureForm: TSignOnlineReportsForm;
  123. begin
  124. vEpureForm := TSignOnlineReportsForm.Create(nil);
  125. try
  126. vEpureForm.Init(AProjectNode, AEpurePhase);
  127. vEpureForm.InitForEpure;
  128. vEpureForm.ShowModal;
  129. finally
  130. vEpureForm.Free;
  131. end;
  132. end;
  133. { TSignOnlineReportsForm }
  134. destructor TSignOnlineReportsForm.Destroy;
  135. begin
  136. ClearObjects(FPreviewList);
  137. FPreviewList.Free;
  138. FReportCon.Free;
  139. FReportDataPrepare.Free;
  140. if Assigned(FProjectData) then
  141. FProjectData.Free;
  142. if DirectoryExists(FTempPath) then
  143. DeleteFileOrFolder(FTempPath);
  144. inherited;
  145. end;
  146. procedure TSignOnlineReportsForm.Init(AProjNode: TsdIDTreeNode; ASignPhase: Integer);
  147. function getTopParent(ANode: TsdIDTreeNode): TsdIDTreeNode;
  148. begin
  149. if Assigned(ANode.Parent) then
  150. Result := getTopParent(ANode.Parent)
  151. else
  152. Result := ANode;
  153. end;
  154. function getName(ANode: TsdIDTreeNode): string;
  155. begin
  156. Result := ANode.Rec.ValueByName('Name').AsString;
  157. end;
  158. begin
  159. FWebProjectID := GetTopParent(AProjNode).Rec.ValueByName('WebID').AsInteger;
  160. FWebTenderID := AProjNode.Rec.ValueByName('WebID').AsInteger;
  161. FSignPhase := ASignPhase;
  162. FProjectData := TProjectData.Create;
  163. FProjectData.OpenForSignOnline(GetMyProjectsFilePath + AProjNode.Rec.ValueByName('FileName').AsString, ASignPhase);
  164. FReportDataPrepare := TReportPrepare.Create(FProjectData);
  165. FReportCon := TReportConnection.Create(FProjectData);
  166. //Caption := Format('生成签署报表 %s-%s-第 %d 期', [getName(getTopParent(AProjectNode)), getName(AProjectNode), ASignPhase]);
  167. Caption := Format('生成签署报表 %s-第 %d 期', [getName(AProjNode), ASignPhase]);
  168. LoadReportTemplates;
  169. FTempPath := GetAppTempPath + IntToStr(AProjNode.ID) + '\';
  170. CreateDirectoryInDeep(FTempPath);
  171. end;
  172. procedure TSignOnlineReportsForm.LoadReportTemplates;
  173. var
  174. vHelper: TTemplateManagerHelper;
  175. begin
  176. vHelper := TTemplateManagerHelper.Create;
  177. try
  178. vHelper.ExportToTreeView(tvReports, ReportTemplateManager);
  179. finally
  180. vHelper.Free;
  181. end;
  182. end;
  183. procedure TSignOnlineReportsForm.FormShow(Sender: TObject);
  184. var
  185. vNode: TTreeNode;
  186. begin
  187. vNode := tvReports.Items.GetFirstNode;
  188. while Assigned(vNode) do
  189. begin
  190. vNode.Expand(True);
  191. vNode := vNode.getNextSibling;
  192. end;
  193. tvReports.Selected := tvReports.Items[0];
  194. end;
  195. procedure TSignOnlineReportsForm.tvReportsClick(Sender: TObject);
  196. var
  197. vTemplate: TTemplateNode;
  198. begin
  199. if Assigned(tvReports.Selected) then
  200. begin
  201. vTemplate := TTemplateNode(tvReports.Selected.Data);
  202. pbGenerate.Visible := Assigned(vTemplate);
  203. cbFillZero.Visible := Assigned(vTemplate);
  204. pnlPageControl.Visible := Assigned(vTemplate);
  205. FPostedSignReports.LoadAllSignReports(PhPWeb.MeasureURL + FLoadListUrl, FWebTenderID, FSignPhase);
  206. lblAlreadyUpload.Visible := Assigned(vTemplate) and Assigned(FPostedSignReports.FindSignReport(FSignPhase, vTemplate.TemplateName));
  207. ReportTemplateManager.Current := vTemplate;
  208. if Assigned(vTemplate) then
  209. LoadTemplateAndDisplay(vTemplate);
  210. tvReports.SetFocus;
  211. end;
  212. end;
  213. procedure TSignOnlineReportsForm.LoadTemplateAndDisplay(ATemplate: TTemplateNode);
  214. procedure WaringAndEmptyPreview(AStr: string);
  215. var
  216. OldBrushColor, OldPenColor: TColor;
  217. begin
  218. TipMessage(AStr, Handle);
  219. ClearObjects(FPreviewList);
  220. pnlPageControl.Visible := False;
  221. end;
  222. procedure ShowAllPages;
  223. const
  224. Indent = 5;
  225. var
  226. iPage: Integer;
  227. vPreviewImage: TImage;
  228. begin
  229. ClearObjects(FPreviewList);
  230. msbReportsPreview.HorzScrollBar.Range := 0;
  231. msbReportsPreview.HorzScrollBar.Position := 0;
  232. msbReportsPreview.VertScrollBar.Range := 0;
  233. msbReportsPreview.VertScrollBar.Position := 0;
  234. for iPage := 1 to PreviewComXML.TotalPages do
  235. begin
  236. vPreviewImage := TImage.Create(msbReportsPreview);
  237. vPreviewImage.Parent := msbReportsPreview;
  238. vPreviewImage.Top := (PreviewComXML.PrintHeight + Indent) * (iPage - 1);
  239. vPreviewImage.Left := 0;
  240. PreviewPage(vPreviewImage, iPage);
  241. FPreviewList.Add(vPreviewImage);
  242. end;
  243. msbReportsPreview.HorzScrollBar.Range := PreviewComXML.PrintWidth;
  244. msbReportsPreview.VertScrollBar.Range := PreviewComXML.PrintHeight * PreviewComXML.TotalPages + 10 * (PreviewComXML.TotalPages - 1);
  245. end;
  246. procedure ShowCurPages;
  247. var
  248. vPreviewImage: TImage;
  249. begin
  250. ClearObjects(FPreviewList);
  251. msbReportsPreview.HorzScrollBar.Position := 0;
  252. msbReportsPreview.VertScrollBar.Position := 0;
  253. vPreviewImage := TImage.Create(msbReportsPreview);
  254. vPreviewImage.Parent := msbReportsPreview;
  255. vPreviewImage.Top := 0;
  256. vPreviewImage.Left := 0;
  257. FPreviewList.Add(vPreviewImage);
  258. msbReportsPreview.HorzScrollBar.Range := PreviewComXML.ReportSize.X;
  259. msbReportsPreview.VertScrollBar.Range := PreviewComXML.ReportSize.Y;
  260. vPreviewImage.OnMouseMove := OnViewMouseMove;
  261. vPreviewImage.OnMouseDown := OnViewMouseDown;
  262. CurPage := 1;
  263. end;
  264. procedure PreviewTemplet(AIsShowAllPages: Boolean);
  265. begin
  266. try
  267. if AIsShowAllPages then
  268. ShowAllPages
  269. else
  270. ShowCurPages;
  271. pnlPageControl.Visible := not AIsShowAllPages;
  272. msbReportsPreview.SetFocus;
  273. except
  274. WaringAndEmptyPreview('当前报表显示可能存在问题,请与纵横客服中心联系:(0756)3850888。');
  275. end;
  276. end;
  277. procedure LoadEmptyTempletAndDisplay;
  278. begin
  279. WaringAndEmptyPreview('报表无数据,请选择其他报表。');
  280. end;
  281. begin
  282. // 交互表
  283. if ATemplate.InteractFlag <> 0 then
  284. SaveReportInteractData(ATemplate);
  285. // 准备额外数据
  286. if ATemplate.DataPrepareFlag <> 0 then
  287. FReportDataPrepare.PrepareData(ATemplate.DataPrepareFlag);
  288. FReportCon.RefreshConnection(ATemplate);
  289. Screen.Cursor := crHourGlass;
  290. try
  291. LoadTemplet(ATemplate, PreviewComXML);
  292. if PreviewComXML.TotalPages > 0 then
  293. PreviewTemplet(False)
  294. else
  295. LoadEmptyTempletAndDisplay;
  296. finally
  297. Screen.Cursor := crDefault;
  298. end;
  299. end;
  300. procedure TSignOnlineReportsForm.LoadTemplet(ATemplate: TTemplateNode;
  301. APrintCom: TPrintComXML);
  302. var
  303. RptArchiverObj: TReportArchiver;
  304. Mem: TMemoryStream;
  305. begin
  306. RptArchiverObj := TReportArchiver.Create;
  307. if ATemplate.IsMulti then
  308. RptArchiverObj.FileName := ATemplate.MultiFileNames[FProjectData.PhaseIndex]
  309. else
  310. RptArchiverObj.FileName := ATemplate.FileName;
  311. Mem := RptArchiverObj.Extract;
  312. try
  313. // 以下代码有顺序限制,不可修改,主要保证在不修改报表模板文件的基础上可以用户定制报表格式
  314. // 私以为,原因在于这些设置修改后,并不能生效,需要保存再读取方可生效
  315. // 读取报表模板
  316. if not APrintCom.ReadReportStream(Mem) then Exit;
  317. // 将报表设置中的数据覆盖掉原模板的数据
  318. InitReportSettings(APrintCom, ATemplate);
  319. // 保存
  320. APrintCom.SaveToStream(Mem);
  321. // 再次读取,使报表设置中的设置生效
  322. APrintCom.ReadReportStream(Mem);
  323. // ReadReportStream之后会将PreviewComXML的FillZero值赋为True,故再赋值一次
  324. // To Do
  325. APrintCom.FillZero := cbFillZero.Checked;
  326. InitPageSettings(APrintCom);
  327. APrintCom.ReadDBData;
  328. APrintCom.AnalyseData(PreviewBox.Canvas);
  329. finally
  330. if Mem <> nil then
  331. Mem.Free;
  332. RptArchiverObj.Free;
  333. end;
  334. end;
  335. procedure TSignOnlineReportsForm.InitFont(APrintCom: TPrintComXML);
  336. procedure AssignFontRec(AFontRec: TFontRec; AFont: TFont);
  337. begin
  338. AFontRec.FontName := AFont.Name;
  339. AFontRec.FontHeight := Round(AFont.Size*4/3) ;
  340. AFontRec.FontBold := 400 + Integer(fsBold in AFont.Style)*200;
  341. AFontRec.FontItalic := Integer(fsItalic in AFont.Style);
  342. AFontRec.FontUnderLine := Integer(fsUnderLine in AFont.Style);
  343. end;
  344. procedure InitTitleFont;
  345. var
  346. TitleRec : PTitleRec;
  347. begin
  348. TitleRec := PreviewComXML.getTitleByID(1);
  349. if TitleRec <> nil then
  350. begin
  351. AssignFontRec(TitleRec.FontRec, ReportConfig.TitleFont);
  352. APrintCom.setTitleObj(TitleRec);
  353. end;
  354. end;
  355. procedure InitColumnFont;
  356. procedure InitColumnThick(AColumnRec: PColumnRec);
  357. begin
  358. if (ReportConfig.ReportCellLine > 0.2) then
  359. begin
  360. if (AColumnRec.LineInfo.LeftThick > 0.2) then
  361. AColumnRec.LineInfo.LeftThick := ReportConfig.ReportCellLine;
  362. if (AColumnRec.LineInfo.RightThick > 0.2) then
  363. AColumnRec.LineInfo.RightThick := ReportConfig.ReportCellLine;
  364. if (AColumnRec.LineInfo.TopThick > 0.2) then
  365. AColumnRec.LineInfo.TopThick := ReportConfig.ReportCellLine;
  366. if (AColumnRec.LineInfo.BottomThick > 0.2) then
  367. AColumnRec.LineInfo.BottomThick := ReportConfig.ReportCellLine;
  368. end;
  369. end;
  370. var
  371. i, j: Integer;
  372. ObjList: TList;
  373. ColumnRec : PColumnRec;
  374. AAR : PActiveAreaRec;
  375. SER : PShowElementRec;
  376. begin
  377. ObjList := TList.Create;
  378. try
  379. APrintCom.getAllColumnHeadObjs(ObjList);
  380. for i := 0 to ObjList.Count - 1 do
  381. begin
  382. ColumnRec := ObjList[i];
  383. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  384. InitColumnThick(ColumnRec);
  385. APrintCom.setColumnHeadTailObj(0, ColumnRec);
  386. end;
  387. APrintCom.getAllColumnTailObjs(ObjList);
  388. for i := 0 to ObjList.Count - 1 do
  389. begin
  390. ColumnRec := ObjList[i];
  391. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  392. InitColumnThick(ColumnRec);
  393. APrintCom.setColumnHeadTailObj(1,ColumnRec);
  394. end;
  395. APrintCom.getAllActAreaObjs(ObjList);
  396. for i := 0 to ObjList.Count - 1 do
  397. begin
  398. AAR := ObjList[i];
  399. for j := 0 to AAR.ElementList.Count - 1 do
  400. begin
  401. SER := AAR.ElementList[j];
  402. if (SER.ElementType = 7) then
  403. begin
  404. ColumnRec := SER.Data;
  405. AssignFontRec(ColumnRec.FontRec, ReportConfig.ColumnFont);
  406. InitColumnThick(ColumnRec);
  407. APrintCom.setActShowElementObj(SER);
  408. end;
  409. end;
  410. end;
  411. finally
  412. ObjList.Free;
  413. end;
  414. end;
  415. procedure InitContentAndGatherFont;
  416. var
  417. i, j: Integer;
  418. ObjList: TList;
  419. FlowContentRec : PContentRec;
  420. CrossContentRec : PCrossContentRec;
  421. SumRec : PSumRec;
  422. begin
  423. ObjList := TList.Create;
  424. try
  425. // 设置表正文
  426. APrintCom.getAllFlowShowContentObjs(ObjList);
  427. for i := 0 to ObjList.Count - 1 do
  428. begin
  429. FlowContentRec := ObjList[i];
  430. if not (FlowContentRec.Fixed) then
  431. begin
  432. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  433. APrintCom.setFlowContentObj(FlowContentRec);
  434. end;
  435. end;
  436. APrintCom.getAllBillShowContentObjs(ObjList);
  437. for i := 0 to ObjList.Count - 1 do
  438. begin
  439. FlowContentRec := ObjList[i];
  440. if not(FlowContentRec.Fixed) then
  441. begin
  442. AssignFontRec(FlowContentRec.FontRec, ReportConfig.ContentFont);
  443. APrintCom.setBillContentObj(FlowContentRec);
  444. end;
  445. end;
  446. APrintCom.getAllCrossContentObjs(ObjList);
  447. for i := 0 to ObjList.Count - 1 do
  448. begin
  449. CrossContentRec := ObjList[i];
  450. if not(CrossContentRec.CrossContent.Fixed) then
  451. begin
  452. AssignFontRec(CrossContentRec.CrossContent.FontRec, ReportConfig.ContentFont);
  453. APrintCom.setCrossContentObj(CrossContentRec);
  454. end;
  455. end;
  456. // 设置表合计
  457. for i := 0 to 2 do
  458. begin
  459. APrintCom.getAllSumObjs(i,ObjList);
  460. for j := 0 to ObjList.Count - 1 do
  461. begin
  462. SumRec := ObjList[j];
  463. AssignFontRec(SumRec.FontRec, ReportConfig.GatherFont);
  464. APrintCom.setSumObj(SumRec);
  465. end;
  466. end;
  467. finally
  468. ObjList.Free;
  469. end;
  470. end;
  471. procedure InitGridHeaderFont;
  472. var
  473. i: Integer;
  474. ObjList: TList;
  475. HeadTailRec : PHeadRec;
  476. begin
  477. ObjList := TList.Create;
  478. try
  479. APrintCom.getAllHeadObjs(ObjList);
  480. for i := 0 to ObjList.Count - 1 do
  481. begin
  482. HeadTailRec := ObjList[i];
  483. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  484. APrintCom.setHeadTailObj(0, HeadTailRec);
  485. end;
  486. APrintCom.getAllTailObjs(ObjList);
  487. for i := 0 to ObjList.Count - 1 do
  488. begin
  489. HeadTailRec := ObjList[i];
  490. AssignFontRec(HeadTailRec.FontRec, ReportConfig.GridHeaderFont);
  491. APrintCom.setHeadTailObj(1, HeadTailRec);
  492. end;
  493. finally
  494. ObjList.Free;
  495. end;
  496. end;
  497. begin
  498. InitTitleFont;
  499. InitColumnFont;
  500. InitContentAndGatherFont;
  501. InitGridHeaderFont;
  502. end;
  503. procedure TSignOnlineReportsForm.InitPageSettings(APrintCom: TPrintComXML);
  504. begin
  505. // 设置页面大小
  506. APrintCom.setPageSize(ReportConfig.PageSize);
  507. if ReportConfig.PageSize = 'A3' then
  508. APrintCom.PrintPageSizeIdx := DMPAPER_A3
  509. else if ReportConfig.PageSize = 'A4' then
  510. APrintCom.PrintPageSizeIdx := DMPAPER_A4;
  511. // 设置边距
  512. APrintCom.setEdge(0, '', ReportConfig.LeftEdge/10);
  513. APrintCom.setEdge(1, '', ReportConfig.RightEdge/10);
  514. APrintCom.setEdge(2, '', ReportConfig.UpEdge/10);
  515. APrintCom.setEdge(3, '', ReportConfig.DownEdge/10);
  516. end;
  517. procedure TSignOnlineReportsForm.InitPaperSettings(
  518. ATemplate: TTemplateNode; APrintCom: TPrintComXML);
  519. procedure InitRepBorderLine;
  520. var
  521. i: Integer;
  522. ObjList : TList;
  523. ShapeRec : PPicRec;
  524. begin
  525. ObjList := TList.Create;
  526. try
  527. APrintCom.getAllShapeObjs(1, ObjList);
  528. for i := 0 to ObjList.Count - 1 do
  529. begin
  530. ShapeRec := ObjList[i];
  531. // 设置报表边框线粗
  532. ShapeRec.PenWidth := ReportConfig.BorderLine;
  533. // 设置是否绘制报表边框横线
  534. if (ShapeRec.ExArea.ExLeft <> ShapeRec.ExArea.ExRight) then
  535. begin
  536. if not ReportConfig.RepBorderUnderLine then
  537. ShapeRec.PenStyle := integer(psClear)
  538. else
  539. ShapeRec.PenStyle := integer(psSolid);
  540. end;
  541. // 设置是否绘制报表边框竖线
  542. if (ShapeRec.ExArea.ExTop <> ShapeRec.ExArea.ExBottom) and
  543. ((ShapeRec.ExArea.ExLeft = 0) or (ShapeRec.ExArea.ExLeft = 100)) then
  544. begin //这里的判断条件是约定好的
  545. if not ReportConfig.RepBorderVerLine then
  546. ShapeRec.PenStyle := integer(psClear)
  547. else
  548. ShapeRec.PenStyle := integer(psSolid)
  549. end;
  550. APrintCom.setShapeObj(ShapeRec);
  551. end;
  552. finally
  553. ObjList.Free;
  554. end;
  555. end;
  556. procedure InitRepCellLine;
  557. var
  558. i: Integer;
  559. ObjList : TList;
  560. ColumnRec : PColumnRec;
  561. FlowContentRec : PContentRec;
  562. CrossContentRec : PCrossContentRec;
  563. begin
  564. ObjList := TList.Create;
  565. try
  566. APrintCom.getAllFlowShowContentObjs(ObjList);
  567. // 设置报表表格横线
  568. for i := 0 to ObjList.Count - 1 do
  569. begin
  570. FlowContentRec := ObjList[i];
  571. FlowContentRec.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  572. FlowContentRec.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  573. APrintCom.setFlowContentObj(FlowContentRec);
  574. end;
  575. APrintCom.getAllCrossContentObjs(ObjList);
  576. for i := 0 to ObjList.Count - 1 do
  577. begin
  578. CrossContentRec := ObjList[i];
  579. CrossContentRec.CrossContent.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  580. CrossContentRec.CrossContent.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  581. APrintCom.setCrossContentObj(CrossContentRec);
  582. end;
  583. // 设置报表表格竖线
  584. APrintCom.getAllFlowShowContentObjs(ObjList);
  585. for i := 0 to ObjList.Count - 1 do
  586. begin
  587. FlowContentRec := ObjList[i];
  588. FlowContentRec.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  589. FlowContentRec.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  590. // 如果设置无表格边框线,则两端的表格竖线线粗为0
  591. if (not ReportConfig.RepBorderVerLine) then
  592. if (i = 0) then
  593. FlowContentRec.LineInfo.LeftThick := 0
  594. else if (i = ObjList.Count - 1) then
  595. FlowContentRec.LineInfo.RightThick := 0;
  596. APrintCom.setFlowContentObj(FlowContentRec);
  597. end;
  598. APrintCom.getAllCrossContentObjs(ObjList);
  599. for i := 0 to ObjList.Count - 1 do
  600. begin
  601. CrossContentRec := ObjList[i];
  602. CrossContentRec.CrossContent.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  603. CrossContentRec.CrossContent.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  604. ColumnRec := CrossContentRec.CrossContent.Column;
  605. //这里还要判断如果没有边框竖线的情况下,表格竖线边缘的线粗也为0
  606. //前提是所属表栏最右位置位于边缘
  607. if (not ReportConfig.RepBorderVerLine) and (ColumnRec<>nil) and
  608. ((ColumnRec.ExArea.ExRight = 100.0) or (ColumnRec.ExArea.ExLeft = 0.0)) then
  609. begin
  610. case CrossContentRec.CrossType of
  611. 0 : //交叉行
  612. begin
  613. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  614. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  615. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  616. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  617. end;
  618. 1 : //交叉列
  619. begin
  620. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  621. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  622. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  623. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  624. //(*
  625. if (CrossContentRec.CrossContent.isSpecialBorder) then
  626. begin
  627. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  628. CrossContentRec.CrossContent.SpecialLineInfo.RightThick := 0;
  629. end;
  630. //*)
  631. end;
  632. 2 : //显示数据
  633. begin
  634. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  635. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  636. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  637. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  638. end;
  639. 3 : //固定LABEL
  640. begin
  641. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  642. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  643. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  644. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  645. end;
  646. 4 : //序号
  647. begin
  648. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  649. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  650. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  651. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  652. end;
  653. 5 : //横向统计
  654. begin
  655. if (CrossContentRec.CrossContent.ExArea.ExLeft = ColumnRec.ExArea.ExLeft ) then
  656. CrossContentRec.CrossContent.LineInfo.LeftThick := 0;
  657. if (CrossContentRec.CrossContent.ExArea.ExRight = ColumnRec.ExArea.ExRight ) then
  658. CrossContentRec.CrossContent.LineInfo.RightThick := 0;
  659. end;
  660. end;
  661. end;
  662. APrintCom.setCrossContentObj(CrossContentRec);
  663. end;
  664. finally
  665. ObjList.Free;
  666. end;
  667. end;
  668. procedure InitOtherArea;
  669. procedure SetPTRBorder(PTR : PTextRec);
  670. procedure SetLeftRightBorder;
  671. begin
  672. if PTR.ExArea.ExLeft = 0.0 then
  673. begin
  674. if BorderWidth = 0.0 then
  675. PTR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth;
  676. end;
  677. if PTR.ExArea.ExRight = 100.0 then
  678. begin
  679. if BorderWidth = 0.0 then
  680. PTR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth
  681. end;
  682. end;
  683. procedure SetHorLine;
  684. begin
  685. if (PTR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  686. PTR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  687. if (PTR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  688. PTR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  689. end;
  690. begin
  691. SetLeftRightBorder;
  692. SetHorLine;
  693. end;
  694. procedure SetPCRBorder(PCR : PColumnRec);
  695. procedure SetLeftRightBorder;
  696. begin
  697. if PCR.ExArea.ExLeft = 0.0 then
  698. begin
  699. if BorderWidth = 0.0 then
  700. PCR.LineInfo.LeftThick := ReportConfig.BorderUnderLineWidth
  701. end;
  702. if PCR.ExArea.ExRight = 100.0 then
  703. begin
  704. if BorderWidth = 0.0 then
  705. PCR.LineInfo.RightThick := ReportConfig.BorderUnderLineWidth;
  706. end;
  707. end;
  708. procedure SetVerLine;
  709. begin
  710. if PCR.ExArea.ExLeft = 0.0 then
  711. PCR.LineInfo.LeftThick := ReportConfig.CellVerLineWidth;
  712. if PCR.ExArea.ExRight = 100.0 then
  713. PCR.LineInfo.RightThick := ReportConfig.CellVerLineWidth;
  714. end;
  715. procedure SetHorLine;
  716. begin
  717. if (PCR.LineInfo.TopThick >= 0.2) and (BorderWidth <= 0.2) then
  718. PCR.LineInfo.TopThick := ReportConfig.CellHorLineWidth;
  719. if (PCR.LineInfo.BottomThick >= 0.2) and (BorderWidth <= 0.2) then
  720. PCR.LineInfo.BottomThick := ReportConfig.CellHorLineWidth;
  721. end;
  722. begin
  723. SetLeftRightBorder;
  724. SetVerLine;
  725. SetHorLine;
  726. end;
  727. var i,k : integer;
  728. ObjList : TList;
  729. ActAreaRec : PActiveAreaRec;
  730. PSR : PShowElementRec;
  731. begin
  732. ObjList := TList.Create;
  733. try
  734. ActAreaRec := nil;
  735. PreviewComXML.getAllActAreaObjs(ObjList);
  736. for i := 0 to ObjList.Count - 1 do
  737. begin
  738. ActAreaRec := ObjList[i];
  739. if (ActAreaRec.ShowType < 0) or (ActAreaRec.ShowType > 2) then Continue;
  740. if not Assigned(ActAreaRec.ElementList) then Continue;
  741. for k := 0 to ActAreaRec.ElementList.Count - 1 do
  742. begin
  743. PSR := PShowElementRec(ActAreaRec.ElementList[k]);
  744. case PSR.ElementType of
  745. 0..2 : SetPTRBorder(PSR.Data); //文本,参数,字段,表栏
  746. 7 : SetPCRBorder(PSR.Data) //Column
  747. end;
  748. APrintCom.setActShowElementObj(PSR);
  749. end;
  750. end;
  751. finally
  752. ObjList.Free;
  753. end;
  754. end;
  755. begin
  756. if not Assigned(ATemplate) or (ATemplate.SelfFormat = 0) then
  757. begin
  758. InitFont(APrintCom); // 各类字体
  759. InitRepBorderLine; // 报表边框
  760. InitRepCellLine; // 报表表格
  761. InitOtherArea; // 活动区域
  762. end;
  763. end;
  764. procedure TSignOnlineReportsForm.SaveAuditOpinion(
  765. ATemplate: TTemplateNode);
  766. var
  767. SelectForm: TAuditSelctForm;
  768. begin
  769. SelectForm := TAuditSelctForm.Create(FProjectData, ATemplate);
  770. try
  771. if SelectForm.ShowModal = mrOk then
  772. SelectForm.SaveAuditData;
  773. finally
  774. SelectForm.Free;
  775. end;
  776. end;
  777. procedure TSignOnlineReportsForm.SaveReportInteractData(
  778. ATemplate: TTemplateNode);
  779. begin
  780. case ATemplate.InteractFlag of
  781. 1: SaveAuditOpinion(ATemplate);
  782. end;
  783. end;
  784. procedure TSignOnlineReportsForm.InitReportSettings(
  785. APrintCom: TPrintComXML; ATemplate: TTemplateNode);
  786. begin
  787. InitPageSettings(APrintCom);
  788. InitPaperSettings(ATemplate, APrintCom);
  789. APrintCom.ShowBackgroundMark := FProjectData.ProjProperties.ShowReportShading;
  790. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShading;
  791. if FProjectData.ProjProperties.ReportShowState then
  792. begin
  793. if FProjectData.ProjProperties.ReportShowStateWithoutReply and
  794. ((FProjectData.ProjProperties.AuditStatus = -1) or (FProjectData.PhaseIndex < FProjectData.ProjProperties.PhaseCount)) then
  795. APrintCom.ShowBackgroundMark := False
  796. else
  797. APrintCom.ShowBackgroundMark := True;
  798. end
  799. else
  800. APrintCom.ShowBackgroundMark := False;
  801. APrintCom.BackgroundMarkStr := FProjectData.ProjProperties.ReportShowStateText;
  802. end;
  803. procedure TSignOnlineReportsForm.PreviewComXMLContentDisplay(
  804. var contentFontRec: TFontRec; dataType: Integer; isReading: Boolean;
  805. DrawType: Integer; isPrinting: Boolean);
  806. begin
  807. if ReportConfig.ContentIsNarrow then
  808. begin
  809. if (isReading) then
  810. begin
  811. begin
  812. contentFontRec.FontName := 'Arial Narrow';
  813. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  814. end;
  815. end else
  816. begin
  817. if (DrawType = 3) or (DrawType = 5) then
  818. begin
  819. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3);
  820. end else if (isPrinting) then
  821. begin
  822. contentFontRec.FontName := 'Arial Narrow';
  823. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 7 div 6;
  824. end else
  825. begin
  826. contentFontRec.FontHeight := Round(ReportConfig.ContentFont.Size*4/3) * 4 div 3;
  827. end;
  828. end;
  829. end;
  830. end;
  831. procedure TSignOnlineReportsForm.PreviewComXMLCrossTabLabelShow(
  832. valIDX: Integer; var ExLeft, ExRight: Double; var isShow: Boolean;
  833. CrsTabShowType: Integer);
  834. var
  835. field : PFieldRec;
  836. begin
  837. if (CrsTabShowType = -1) then exit;
  838. field := PreviewComXML.getFieldByID(6);
  839. if (field <> nil) then
  840. begin
  841. if (field.DataLen > valIDX) and (valIDX >= 0) then
  842. begin
  843. if (field.Value[valIDX] = 1.5) then
  844. begin
  845. case CrsTabShowType of
  846. 1 : begin
  847. isShow := false;
  848. end;
  849. 2 : begin
  850. ExLeft := 0;
  851. ExRight := 100;
  852. end;
  853. 3 : begin
  854. //
  855. end
  856. else
  857. begin
  858. //
  859. end;
  860. end;
  861. end;
  862. end;
  863. end;
  864. end;
  865. procedure TSignOnlineReportsForm.PreviewComXMLGetDataConnection(
  866. var ADOCon: TADOConnection);
  867. begin
  868. ADOCon := FReportCon.Connection;
  869. end;
  870. procedure TSignOnlineReportsForm.PreviewComXMLGetDatasetEvent(
  871. DatasetInfo: PDatasetInfoRec; var ADataset: TDataSet);
  872. begin
  873. if DatasetInfo.ID = 0 then
  874. ADataSet := MemoryReportManager.GetSqlResultDataSet(ReportTemplateManager.Current.InteractInfo.Sql, FProjectData)
  875. else
  876. ADataset := MemoryReportManager.GetMemoryDataSet(DatasetInfo.ID, FProjectData);
  877. end;
  878. procedure TSignOnlineReportsForm.PreviewPage(AImage: TImage;
  879. APageIndex: Integer);
  880. begin
  881. if Assigned(AImage) then
  882. begin
  883. AImage.Height := PreviewComXML.ReportSize.Y;
  884. AImage.Picture.Bitmap.Height := PreviewComXML.ReportSize.Y;
  885. AImage.Width := PreviewComXML.ReportSize.X;
  886. AImage.Picture.Bitmap.Width := PreviewComXML.ReportSize.X;
  887. PreviewComXML.PrintPreviewCanvas(APageIndex, 0, AImage.Canvas, False);
  888. end;
  889. end;
  890. constructor TSignOnlineReportsForm.Create(AOwner: TComponent);
  891. procedure LoadCursor(AIndex: Integer; const AFileName: string);
  892. var
  893. rst: Integer;
  894. begin
  895. rst := LoadCursorFromFile(PChar(AFileName));
  896. if rst <> 0 then
  897. Screen.Cursors[AIndex] := rst;
  898. end;
  899. begin
  900. inherited;
  901. FPreviewList := TList.Create;
  902. LoadCursor(crPrevious, GetAppFilePath + 'PreviousPage.cur');
  903. LoadCursor(crNext, GetAppFilePath + 'NextPage.cur');
  904. FPostedSignReports := TSignReports.Create;
  905. end;
  906. procedure TSignOnlineReportsForm.msbReportsPreviewMouseWheelDown(
  907. Sender: TObject; Shift: TShiftState; MousePos: TPoint;
  908. var Handled: Boolean);
  909. begin
  910. SendMessage(TMScrollBox(Sender).Handle, WM_VSCROLL, SB_LINEDOWN, 0);
  911. end;
  912. procedure TSignOnlineReportsForm.msbReportsPreviewMouseWheelUp(
  913. Sender: TObject; Shift: TShiftState; MousePos: TPoint;
  914. var Handled: Boolean);
  915. begin
  916. SendMessage(TMScrollBox(Sender).Handle, WM_VSCROLL, SB_LINEUP, 0);
  917. end;
  918. procedure TSignOnlineReportsForm.ScrollBox1MouseWheelDown(Sender: TObject;
  919. Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  920. begin
  921. SendMessage(TScrollBox(Sender).Handle, WM_VSCROLL, SB_LINEDOWN, 0);
  922. end;
  923. procedure TSignOnlineReportsForm.ScrollBox1MouseWheelUp(Sender: TObject;
  924. Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
  925. begin
  926. SendMessage(TScrollBox(Sender).Handle, WM_VSCROLL, SB_LINEUP, 0);
  927. end;
  928. procedure TSignOnlineReportsForm.ExportReports(const AFileName: string);
  929. var
  930. ATempFolder: String;
  931. i: Integer;
  932. begin
  933. ATempFolder := GenerateTempFolder(GetTempFilePath);
  934. for i := 1 to PreviewComXML.TotalPages do
  935. begin
  936. ExportReportPage(i, Format('%s\%d.jpg', [ATempFolder, i]));
  937. end;
  938. ZipFolder(ATempFolder, AFileName);
  939. end;
  940. procedure TSignOnlineReportsForm.btnPreClick(Sender: TObject);
  941. begin
  942. if CurPage > 1 then
  943. CurPage := CurPage - 1
  944. else
  945. WarningMessage('已经是最前了');
  946. end;
  947. procedure TSignOnlineReportsForm.btnNextClick(Sender: TObject);
  948. begin
  949. if CurPage < PreviewComXML.TotalPages then
  950. CurPage := CurPage + 1
  951. else
  952. WarningMessage('已经是最后了');
  953. end;
  954. procedure TSignOnlineReportsForm.SetCurPage(const Value: Integer);
  955. begin
  956. FCurPage := Value;
  957. PreviewPage(TImage(FPreviewList.Items[0]), FCurPage);
  958. lblPages.Caption := Format('%d/%d', [FCurPage, PreviewComXML.TotalPages]);
  959. end;
  960. procedure TSignOnlineReportsForm.pbGenerateClick(Sender: TObject);
  961. begin
  962. if FUploadType = utSign then
  963. GenerateSignReport
  964. else if FUploadType = utEpure then
  965. GenerateEpureReport;
  966. end;
  967. procedure TSignOnlineReportsForm.OnViewMouseMove(Sender: TObject;
  968. Shift: TShiftState; X, Y: Integer);
  969. begin
  970. if (X < offset) and (CurPage > 1) then
  971. begin
  972. TControl(Sender).Cursor := crPrevious;
  973. end
  974. else if (X > TControl(Sender).Width - 150) and (CurPage < PreviewComXML.TotalPages) then
  975. begin
  976. TControl(Sender).Cursor := crNext;
  977. end
  978. else
  979. begin
  980. TControl(Sender).Cursor := crDefault;
  981. end;
  982. end;
  983. procedure TSignOnlineReportsForm.OnViewMouseDown(Sender: TObject;
  984. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  985. begin
  986. if (X < offset) and (CurPage > 1) then
  987. begin
  988. CurPage := CurPage - 1;
  989. end
  990. else if (X > TControl(Sender).Width - 150) and (CurPage < PreviewComXML.TotalPages) then
  991. begin
  992. CurPage := CurPage + 1;
  993. end;
  994. end;
  995. procedure TSignOnlineReportsForm.ExportPdfReports(const AFileName: string);
  996. procedure ExportReportPage(APage: Integer; const APageFileName: string);
  997. var
  998. imgEn: TImageEnView;
  999. begin
  1000. imgEn := TImageEnView.Create(nil);
  1001. try
  1002. imgEn.Visible := False;
  1003. imgEn.Parent := Self;
  1004. imgEn.IO.CreatePDFFile(APageFileName);
  1005. imgEn.Bitmap.Height := PreviewComXML.ReportSize.X;
  1006. imgEn.Bitmap.Width := PreviewComXML.ReportSize.Y;
  1007. PreviewComXML.PrintPreviewCanvas(APage, 0, imgEn.Bitmap.Canvas, False);
  1008. imgEn.IO.SaveToPDF;
  1009. finally
  1010. imgEn.Free;
  1011. end;
  1012. end;
  1013. var
  1014. ATempFolder: String;
  1015. i: Integer;
  1016. begin
  1017. ATempFolder := GenerateTempFolder(GetTempFilePath);
  1018. for i := 1 to PreviewComXML.TotalPages do
  1019. begin
  1020. ExportReportPage(i, Format('%s\%d.pdf', [ATempFolder, i]));
  1021. end;
  1022. ZipFolder(ATempFolder, AFileName);
  1023. end;
  1024. function TSignOnlineReportsForm.SafeReportName(var AName: string): Boolean;
  1025. var
  1026. sOrgName: string;
  1027. iCount: Integer;
  1028. bHasQuest: Boolean;
  1029. begin
  1030. Result := False;
  1031. sOrgName := AName;
  1032. iCount := 0;
  1033. FPostedSignReports.LoadAllSignReports(PhPWeb.MeasureURL + FLoadListUrl, FWebTenderID, FSignPhase);
  1034. while Assigned(FPostedSignReports.FindSignReport(FSignPhase, AName)) do
  1035. begin
  1036. Inc(iCount);
  1037. AName := Format('%s(%d)', [sOrgName, iCount]);
  1038. end;
  1039. Result := SameText(sOrgName, AName);
  1040. if not Result then
  1041. Result := QuestRenameSignReport(AName, FSignPhase);
  1042. end;
  1043. procedure TSignOnlineReportsForm.cbFillZeroClick(Sender: TObject);
  1044. begin
  1045. PreviewComXML.FillZero := cbFillZero.Checked;
  1046. PreviewPage(TImage(FPreviewList.Items[0]), FCurPage);
  1047. end;
  1048. procedure TSignOnlineReportsForm.InitForEpure;
  1049. begin
  1050. Caption := '插入计量草图';
  1051. FUploadType := utEpure;
  1052. lblEpureHint.Visible := True;
  1053. FLoadListUrl := 'sign/list';
  1054. FPostedSignReports.LoadAllSignReports(PhPWeb.MeasureURL + FLoadListUrl, FWebTenderID, FSignPhase);
  1055. end;
  1056. procedure TSignOnlineReportsForm.InitForSign;
  1057. begin
  1058. Caption := '在线签署';
  1059. FUploadType := utSign;
  1060. lblEpureHint.Visible := False;
  1061. FLoadListUrl := 'sign/list';
  1062. FPostedSignReports.LoadAllSignReports(PhPWeb.MeasureURL + FLoadListUrl, FWebTenderID, FSignPhase);
  1063. end;
  1064. procedure TSignOnlineReportsForm.GenerateEpureReport;
  1065. function CreateOnlineEpureReport(const AReportName: string; var AResult: string): Boolean;
  1066. var
  1067. sgsParam: TStrings;
  1068. sMessage: string;
  1069. iResult: Integer;
  1070. begin
  1071. Result := False;
  1072. sgsParam := TStringList.Create;
  1073. try
  1074. sgsParam.Add(Format('project=%d', [FWebProjectID]));
  1075. sgsParam.Add(Format('tender=%d', [FWebTenderID]));
  1076. sgsParam.Add(Format('phaseno=%d', [FSignPhase]));
  1077. sgsParam.Add(Format('name=%s', [AReportName]));
  1078. sgsParam.Add(Format('ownuid=%d', [PHPWeb.UserID]));
  1079. sgsParam.Add(Format('widhei=%d_%d', [Round(PreviewComXML.ReportSizeDou.X * 10), Round(PreviewComXML.ReportSizeDou.Y * 10)]));
  1080. sgsParam.Add(Format('totalnum=%d', [PreviewComXML.TotalPages]));
  1081. iResult := PHPWeb.UrlGet(PHPWeb.MeasureURL + 'intermediate/create', sgsParam, AResult);
  1082. case iResult of
  1083. 0: WarningMessage('网络错误:' + AResult);
  1084. -1: WarningMessage('网络错误:无法连接到云端');
  1085. end;
  1086. Result := (iResult = 1) and (AResult <> '');
  1087. finally
  1088. sgsParam.Free;
  1089. end;
  1090. end;
  1091. function UploadEpureReport(const ASignid, AMd5_sign: string): Boolean;
  1092. var
  1093. ATempFolder, sFileName, sMessage: String;
  1094. vInFields, vInValues: array [0..1] of string;
  1095. vUpFileFields, vUpFileNames: array [0..0] of string;
  1096. i: Integer;
  1097. begin
  1098. Result := False;
  1099. ATempFolder := GenerateTempFolder(GetTempFilePath);
  1100. vInFields[0] := 'signid';
  1101. vInValues[0] := ASignid;
  1102. vInFields[1] := 'md5_sign';
  1103. vInValues[1] := AMd5_sign;
  1104. ShowProgressHint('正在上传数据...', PreviewComXML.TotalPages);
  1105. try
  1106. for i := 1 to PreviewComXML.TotalPages do
  1107. begin
  1108. sFileName := Format('%s\%d.jpg', [ATempFolder, i]);
  1109. ExportReportPage(i, sFileName);
  1110. vUpFileFields[0] := 'imediate';
  1111. vUpFileNames[0] := sFileName;
  1112. if not PHPWeb.UploadFiles('intermediate/upload', vInFields, vInValues, vUpFileFields, vUpFileNames, sMessage) then
  1113. begin
  1114. WarningMessage(sMessage);
  1115. Abort;
  1116. end;
  1117. UpdateProgressPosition(i);
  1118. end;
  1119. Result := True;
  1120. finally
  1121. CloseProgressHint;
  1122. DeleteFileOrFolder(ATempFolder);
  1123. end;
  1124. end;
  1125. var
  1126. sReportName, sResult: string;
  1127. vJ: ISuperObject;
  1128. begin
  1129. sReportName := ReportTemplateManager.Current.TemplateName;
  1130. if SafeReportName(sReportName) then
  1131. begin
  1132. if CreateOnlineEpureReport(sReportName, sResult) then
  1133. begin
  1134. try
  1135. vJ := SO(sResult);
  1136. if UploadEpureReport(vJ['signid'].AsString, vJ['md5_sign'].AsString) then
  1137. TipMessage('上传完成。');
  1138. finally
  1139. FPostedSignReports.AddSignReport(FSignPhase, ReportTemplateManager.Current.TemplateName, PHPWeb.UserID);
  1140. lblAlreadyUpload.Visible := True;
  1141. vJ := nil;
  1142. end;
  1143. end;
  1144. end;
  1145. end;
  1146. procedure TSignOnlineReportsForm.GenerateSignReport;
  1147. var
  1148. sReportName, sZipFile, sPdfFile, sErrorMessage: string;
  1149. vInFields, vInValues: array [0..5] of string;
  1150. vUpFileFields, vUpFileNames: array [0..1] of string;
  1151. begin
  1152. if PreviewComXML.TotalPages > 200 then
  1153. begin
  1154. TipMessage('该报表不支持在线签署功能。');
  1155. Exit;
  1156. end;
  1157. sReportName := ReportTemplateManager.Current.TemplateName;
  1158. if SafeReportName(sReportName) then
  1159. begin
  1160. CreateProgress('上传中,请等待...');
  1161. vInFields[0] := 'project';
  1162. vInValues[0] := IntToStr(FWebProjectID);
  1163. vInFields[1] := 'tender';
  1164. vInValues[1] := IntToStr(FWebTenderID);
  1165. vInFields[2] := 'phaseno';
  1166. vInValues[2] := IntToStr(FSignPhase);
  1167. vInFields[3] := 'name';
  1168. vInValues[3] := sReportName;
  1169. vInFields[4] := 'ownuid';
  1170. vInValues[4] := IntToStr(PHPWeb.UserID);
  1171. vInFields[5] := 'widhei';
  1172. vInValues[5] := Format('%d_%d', [Round(PreviewComXML.ReportSizeDou.X * 10), Round(PreviewComXML.ReportSizeDou.Y * 10)]);
  1173. vUpFileFields[0] := 'upfile';
  1174. vUpFileNames[0] := GetTempFileName(FTempPath, '.zip');
  1175. ExportReports(vUpFileNames[0]);
  1176. vUpFileFields[1] := 'upspdf';
  1177. vUpFileNames[1] := GetTempFileName(FTempPath, '.pdf');
  1178. PdfHelper.ExportAllPages(PreviewComXML, vUpFileNames[1]);
  1179. if PHPWeb.UploadFiles('sign/create', vInFields, vInValues, vUpFileFields, vUpFileNames, sErrorMessage) then
  1180. begin
  1181. FPostedSignReports.AddSignReport(FSignPhase, ReportTemplateManager.Current.TemplateName, PHPWeb.UserID);
  1182. lblAlreadyUpload.Visible := True;
  1183. CloseProgress;
  1184. TipMessage('上传完成。');
  1185. end
  1186. else
  1187. begin
  1188. CloseProgress;
  1189. WarningMessage(Format('%s, 上传数据失败,请重试。', [sErrorMessage]));
  1190. end;
  1191. end;
  1192. end;
  1193. procedure TSignOnlineReportsForm.ExportReportPage(APage: Integer;
  1194. const APageFileName: string);
  1195. var
  1196. bmp, bmpCut: TBitmap;
  1197. img: TJPEGImage;
  1198. iCutHeight, iCutWidth, iCutTop, iCutLeft, iCutRight, iCutBottom: Integer;
  1199. begin
  1200. bmp := TBitmap.Create;
  1201. bmpCut := TBitmap.Create;
  1202. img := TJPEGImage.Create;
  1203. try
  1204. bmp.Height := PreviewComXML.ReportSize.Y;
  1205. bmp.Width := PreviewComXML.ReportSize.X;
  1206. PreviewComXML.PrintPreviewCanvas(APage, 0, bmp.Canvas, False);
  1207. iCutHeight := Round(PreviewComXML.ReportSize.Y / 200);
  1208. iCutWidth := Round(PreviewComXML.ReportSize.X / 200);
  1209. bmpCut.Height := PreviewComXML.ReportSize.Y - iCutHeight * 2;
  1210. bmpCut.Width := PreviewComXML.ReportSize.X - iCutWidth * 2;
  1211. bmpCut.Canvas.CopyRect(Rect(0, 0, bmpCut.Width, bmpCut.Height), bmp.Canvas, Rect(iCutWidth, iCutHeight, bmp.Width - iCutWidth, bmp.Height - iCutHeight));
  1212. img.Assign(bmpCut);
  1213. img.CompressionQuality := 100;
  1214. img.Compress;
  1215. img.SaveToFile(APageFileName);
  1216. finally
  1217. bmpCut.Free;
  1218. bmp.Free;
  1219. img.Free;
  1220. end;
  1221. end;
  1222. end.