ProjectManagerFme.pas 60 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976
  1. unit ProjectManagerFme;
  2. interface
  3. uses
  4. ProjectManagerDm, ZhAPI,
  5. NewProjectFrm,
  6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7. Dialogs, ZjGridDBA, ZJGrid, ComCtrls, ToolWin, ActnList,
  8. dxBar, sdGridDBA, sdGridTreeDBA, sdIDTree, CslJson, ExtCtrls,
  9. StdCtrls, sdDB, CslButton, OrderCheckerFme, Contnrs;
  10. type
  11. TStrArr = array of string;
  12. TProjectManagerFrame = class(TFrame)
  13. ToolBar: TToolBar;
  14. tobtnOpen: TToolButton;
  15. zgProjects: TZJGrid;
  16. tobtnDelete: TToolButton;
  17. ActionList1: TActionList;
  18. actnOpen: TAction;
  19. actnDelete: TAction;
  20. dxpmProjectManager: TdxBarPopupMenu;
  21. actnReceiveProject: TAction;
  22. stdProjects: TsdGridTreeDBA;
  23. actnNewProject: TAction;
  24. actnNewSubProject: TAction;
  25. actnNewTender: TAction;
  26. pnlTenderProperty: TPanel;
  27. sdTenderProperty: TsdGridDBA;
  28. sprProperty: TSplitter;
  29. tobtnRenane: TToolButton;
  30. actnRename: TAction;
  31. tobtnImport: TToolButton;
  32. tobtnExport: TToolButton;
  33. actnImport: TAction;
  34. actnExport: TAction;
  35. tobtn1: TToolButton;
  36. pnlWeb: TPanel;
  37. pnlProject: TPanel;
  38. shp2: TShape;
  39. shp1: TShape;
  40. shp3: TShape;
  41. shp4: TShape;
  42. pnlTenderTitle: TPanel;
  43. lblBidName: TLabel;
  44. pnlShadow: TPanel;
  45. pnlProgress: TPanel;
  46. lblPeriodTotal: TLabel;
  47. lblPeriodState: TLabel;
  48. lblProgress: TLabel;
  49. lblPeriod: TLabel;
  50. pnlBelongProject: TPanel;
  51. lblBelongProject: TLabel;
  52. lblProjName: TLabel;
  53. lblLeftHalfBracket: TLabel;
  54. lblOnwerCompany: TLabel;
  55. lblOnwerName: TLabel;
  56. pnlProjectType: TPanel;
  57. lblProjectType: TLabel;
  58. lblWebProjCtgyName: TLabel;
  59. zgTenderProperty: TZJGrid;
  60. actnOpenBackupFolder: TAction;
  61. sbChecker: TScrollBox;
  62. actnSignOnline: TAction;
  63. actnGuest: TAction;
  64. procedure actnOpenExecute(Sender: TObject);
  65. procedure actnDeleteExecute(Sender: TObject);
  66. procedure zgProjectsMouseDown(Sender: TObject; Button: TMouseButton;
  67. Shift: TShiftState; X, Y: Integer);
  68. procedure actnReceiveProjectExecute(Sender: TObject);
  69. procedure actnNewProjectExecute(Sender: TObject);
  70. procedure actnNewSubProjectExecute(Sender: TObject);
  71. procedure actnNewTenderExecute(Sender: TObject);
  72. procedure zgProjectsDrawCellText(ACanvas: TCanvas; const ARect: TRect;
  73. const ACoord: TPoint; AGrid: TZJGrid; const Text: String;
  74. var ADefaultDraw: Boolean);
  75. procedure actnNewSubProjectUpdate(Sender: TObject);
  76. procedure actnNewTenderUpdate(Sender: TObject);
  77. procedure zgProjectsCurrentChanged(Sender: TObject; Col, Row: Integer);
  78. procedure actnSubmitProjectUpdate(Sender: TObject);
  79. procedure actnReplyProjectUpdate(Sender: TObject);
  80. procedure actnRenameExecute(Sender: TObject);
  81. procedure actnOpenUpdate(Sender: TObject);
  82. procedure actnImportExecute(Sender: TObject);
  83. procedure actnExportExecute(Sender: TObject);
  84. procedure actnDeleteUpdate(Sender: TObject);
  85. procedure actnOpenBackupFolderExecute(Sender: TObject);
  86. procedure actnRenameUpdate(Sender: TObject);
  87. procedure zgProjectsShowHint(var HintStr: String; var CanShow: Boolean;
  88. var HintInfo: THintInfo; const ACoord: TPoint);
  89. procedure actnExportUpdate(Sender: TObject);
  90. procedure actnOpenBackupFolderUpdate(Sender: TObject);
  91. procedure pnlProgressClick(Sender: TObject);
  92. procedure actnSignOnlineExecute(Sender: TObject);
  93. procedure actnSignOnlineUpdate(Sender: TObject);
  94. procedure actnGuestExecute(Sender: TObject);
  95. procedure actnGuestUpdate(Sender: TObject);
  96. private
  97. FProjectManagerData: TProjectManagerData;
  98. // Chenshilong,2016.03.24
  99. // 这部分线上和本地一致,无需区分
  100. FID: Integer; // 本地标段文件ID
  101. FWebID: Integer; // 关联服务器用的ID(服务器有自己的ID体系)
  102. FWebAuthorID: Integer; // 编制人
  103. FWebOwnerID: Integer; // 业主
  104. // 本地存储值、线上存储值。线上修改后,需要同步到本地
  105. FWebMD5_Local: string; // 本地存储的MD5
  106. FWebMD5_OnLine: string; // 线上存储的最新的MD5(下同)
  107. FWebBidName_Local: string; // 标段名 (当无法同线上取得联系时,本地需要用到该名称来提示)
  108. FWebBidName_OnLine: string;
  109. FWebFolder_OnLine: string; // 这个命名不妥,但很直观。线上的项目名称、项目类型概念跟本地颠倒,很混乱。
  110. FWebSubFolder_OnLine: string;
  111. FWebOwnerCompany: string;
  112. FWebOwnerRole: string;
  113. FWebOwnerName: string;
  114. FWebCheckStatusMy: TCheckStatus; // 登陆用户在当前项目中的工作状态。
  115. FWebCheckStatusProject: TCheckStatus; // 项目的审核状态。
  116. FOnLineCheckerBegin: Integer; // 线上审批的起始人。 010110111 起7止9。 0101101110 起0止0。
  117. FOnLineCheckerEnd: Integer; // 线上审批的截止人。
  118. FOnLineCheckerEndIsOwner: Boolean; // 终审是线上审批
  119. FPhaseTotal: Integer;
  120. FPhaseNo: Integer;
  121. FCurPos: Integer; // 用来控制审核人的添加位置
  122. FCheckers: TOVArr;
  123. FCheckerFrames: TObjectList;
  124. FSignOnlineSwitch: Integer;
  125. function ReceiveFile(const AFileName: string; AIsReback: Boolean = False): Boolean;
  126. function ImportFile(const AFileName: string; AFileMD5: string = ''): Boolean;
  127. procedure ConnectButtonWithAction;
  128. function GetImportProjectName(const AFileName: string; AParent: TsdIDTreeNode): string;
  129. function IsProject(ANode: TsdIDTreeNode): Boolean;
  130. function IsLeafProject(ANode: TsdIDTreeNode): Boolean;
  131. function IsUnEmptyLeafProject(ANode: TsdIDTreeNode): Boolean;
  132. function CheckOpened(ANode: TsdIDTreeNode): Boolean;
  133. procedure SetPropertyVisible(AVisible: Boolean);
  134. procedure ShowProjectInfoTopAndCheckers;
  135. // 网络上的目录结构,本地有则定位,没有则创建。
  136. procedure CheckWebFolders(AFolderID, ASubFolderID: Integer;
  137. AFolderName, ASubFolderName: string);
  138. // ANewBidName: 项目的最新标段名(取自服务器,有人改名了,本地的就变成旧的)
  139. procedure CheckBidName(AID: Integer; ANewBidName: string); overload;
  140. procedure CheckBidName(AUserID, AWebID: Integer; ANewBidName: string); overload;
  141. procedure ClearLocalValues;
  142. procedure GetLocalValues(ARec: TsdDataRecord); overload;
  143. // 用户ID、网络标段ID、Type=1可以定位一个标段。
  144. procedure GetLocalValues(AUserID, AWebID: Integer); overload;
  145. // 1 等待我审核的标段文件; 2 我参与的全部标段文件
  146. procedure DoBatchReceiveOnline(ARequestType: Integer);
  147. function LocalMD5(AUserID, AWebID: Integer): string;
  148. procedure BubbleSortProjects;
  149. // AReceiveKind: 1 接收; 2 导入
  150. function FileDownAndReceive(ADownURL: string; AReceiveKind: Integer): Boolean;
  151. // 线上审批的起止人
  152. procedure OnLineChecker(AAr: TOVArr; var ABegin, AEnd: Integer; var AOnLineEndIsOwner: Boolean);
  153. procedure LoadSignOnlineSwitch;
  154. public
  155. constructor Create(AOwner: TComponent); override;
  156. destructor Destroy; override;
  157. procedure DoBatchReceiveAllOnline;
  158. // AType: -2 繁忙; -1 正常读取; 0 第0期; 1 第1期。
  159. procedure ShowProjectInfoTop(AType: Integer = -1);
  160. function Rec(AProjectID: Integer): TsdDataRecord;
  161. function CurRec: TsdDataRecord;
  162. function CurRecAttachmentPath: string;
  163. function AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
  164. function UserIsChecker(UserID: Integer): Boolean; // 判断指定ID的用户是否是参与人
  165. function IsGuest: Boolean;
  166. property ProjectCheckStatus: TCheckStatus read FWebCheckStatusProject;
  167. end;
  168. implementation
  169. uses
  170. MainFrm, UtilMethods, ProjectCommands, Globals, ConfigDoc, ConstUnit,
  171. WebNewTenderFrm, PHPWebDm, Math, mProgressFrm, ProgressHintFrm,
  172. ShellAPI, ProjectFme, SelectOnlineSignPhaseFrm, SignOnlineReportsFrm,
  173. ConditionalDefines, SetGuestFrm;
  174. {$R *.dfm}
  175. procedure TProjectManagerFrame.ConnectButtonWithAction;
  176. begin
  177. SetDxBtnAction(actnNewProject, MainForm.dxbtnNewProject);
  178. SetDxBtnAction(actnNewSubProject, MainForm.dxbtnNewSubProject);
  179. SetDxBtnAction(actnNewTender, MainForm.dxbtnNewTender);
  180. SetDxBtnAction(actnOpen, MainForm.dxbtnOpenProject);
  181. SetDxBtnAction(actnDelete, MainForm.dxbtnDeleteProject);
  182. SetDxBtnAction(actnReceiveProject, MainForm.dxbtnReceiveProject);
  183. SetDxBtnAction(actnOpenBackupFolder, MainForm.dxbtnOpenBackupFolder);
  184. SetDxBtnAction(actnRename, MainForm.dxbtnRename);
  185. SetDxBtnAction(actnSignOnline, MainForm.dxbtnSignOnline);
  186. SetDxBtnAction(actnGuest, MainForm.dxbtnGuest);
  187. end;
  188. constructor TProjectManagerFrame.Create(AOwner: TComponent);
  189. begin
  190. inherited;
  191. FCheckerFrames := TObjectList.Create;
  192. FProjectManagerData := ProjectManager;
  193. FProjectManagerData.Open;
  194. stdProjects.IDTree := FProjectManagerData.ProjectsTree;
  195. sdTenderProperty.DataView := FProjectManagerData.sdvTenderProperty;
  196. ConnectButtonWithAction;
  197. SetPropertyVisible(False);
  198. sbChecker.Height := 0;
  199. if G_IsCloud then
  200. begin
  201. Application.HintPause := 200;
  202. Application.HintHidePause := 60000;
  203. LoadSignOnlineSwitch;
  204. tobtnImport.Visible := False;
  205. stdProjects.TreeOptions := stdProjects.TreeOptions - [aoAllowUpLevel, aoAllowDownLevel];
  206. stdProjects.Options := stdProjects.Options - [aoAllowUpMove, aoAllowDownMove];
  207. CreateProgress('正在从云端下载新项目');
  208. try
  209. actnReceiveProject.Execute;
  210. finally
  211. CloseProgress;
  212. end;
  213. end;
  214. end;
  215. // 双击打开项目 TagB
  216. procedure TProjectManagerFrame.actnOpenExecute(Sender: TObject);
  217. var
  218. vSel: TsdIDTreeNode;
  219. vRec: TsdDataRecord;
  220. sHint: string;
  221. function SearchFileOnline(AURL: string; var ADownURL, AFolder, ASubFolder, ABidName, AMD5Web, AError: string; var AFolderID, ASubFolderID: Integer): Integer;
  222. var vArr: TOVArr;
  223. begin
  224. Result := PHPWeb.Search(AURL, [''], [''], vArr);
  225. AError := '';
  226. if Result = 1 then
  227. begin
  228. if High(vArr) >= 0 then
  229. begin
  230. ADownURL := vArr[0, 0];
  231. AFolder := vArr[0, 2];
  232. ASubFolder := vArr[0, 3];
  233. AMD5Web := vArr[0, 1];
  234. AFolderID := StrToInt(vArr[0, 4]);
  235. ASubFolderID := StrToInt(vArr[0, 5]);
  236. ABidName := vArr[0, 6];
  237. end
  238. else
  239. Result := 10; // 返回10,表示无记录。用这个数字代表是否觉得怪异?没办法,0被占用了。
  240. end
  241. else if Result = 0 then
  242. AError := PHPWeb.PageError('标段更新数据失败')
  243. else if Result = -1 then
  244. AError := PHPWeb.NetError('标段更新数据失败');
  245. end;
  246. function CanOpen: Boolean;
  247. var
  248. sSearchURL, sDownURL,
  249. sMD5_UnLock, sError, sLocalFile: string;
  250. iSearch, iFolderID, iSubFolderID: Integer;
  251. bLock, bCanImp: Boolean;
  252. vFileCheck: TTenderFileChecker;
  253. begin
  254. Result := False;
  255. // 先按正常接口找到最新的MD5码看是否需要更新
  256. sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]);
  257. iSearch := SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, FWebMD5_OnLine, sError, iFolderID, iSubFolderID);
  258. if iSearch = 1 then
  259. begin
  260. try
  261. CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);
  262. CheckBidName(FID, FWebBidName_OnLine);
  263. finally
  264. if vSel <> nil then
  265. vSel.LocateInControl;
  266. end;
  267. // 打开前一定要先下载最新的标段文件(无论审核有没有通过)
  268. if FWebMD5_OnLine <> FWebMD5_Local then
  269. if not FileDownAndReceive(sDownURL, 1) then Exit;
  270. // 编制人且项目末通过
  271. if (FWebAuthorID = PHPWeb.UserID) and (FWebCheckStatusProject = csNotPass) then
  272. begin
  273. sHint := '本期计量审批不通过,你现在可以:' + #10#13 + '点击【是(Y)】重新开始本期计量,软件将打开本期上报时的数据,开始重新计量;' +
  274. #10#13 +'点击【否(N)】查看不通过计量,软件将打开本期最后审批的数据,重新打开标段' + '可再次打开本确认窗口。';
  275. if Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_Yes then
  276. begin
  277. // 查找原报的文件
  278. sSearchURL := Format('%suser/get/%d/%d/report/file', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);
  279. case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of
  280. 1: ; // 原报文件已正确找到
  281. 0, -1:
  282. begin
  283. sHint := sError + ' 因网络出错,无法连接到云端以获取本期原报上传的文件,无法重新开始本期,请重试。';
  284. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  285. Exit;
  286. end;
  287. end;
  288. if FileDownAndReceive(sDownURL, 2) then
  289. begin
  290. // 这里在线上创建新一期审批人列表、更改标段状态。不再使用同步更新等。
  291. sSearchURL := Format('%suser/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);
  292. case SearchFileOnline(sSearchURL, sDownURL, FWebFolder_OnLine, FWebSubFolder_OnLine, FWebBidName_OnLine, sMD5_UnLock, sError, iFolderID, iSubFolderID) of
  293. 1, 10: // 执行到这里线上审核人列表已创建完毕。无需返回记录值,所以返回值为10。1是为了兼容。
  294. begin
  295. sHint := '【十分重要】:本期计量已重新开始,原报在本次上报完成前,请勿删除该标段或更换电脑。';
  296. Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);
  297. end;
  298. 0, -1:
  299. begin
  300. sHint := sError + ' 因网络出错,无法在线上创建新一期审批人列表、提交项目状态等,请重试。';
  301. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  302. Exit;
  303. end;
  304. end;
  305. end
  306. else
  307. Exit;
  308. end;
  309. end;
  310. end
  311. else if (iSearch = 10) then
  312. begin
  313. if not PHPWeb.ExistInServer(FWebID) then
  314. begin
  315. sHint :='该项目[' + FWebBidName_Local + ']在云端已被删除,点击"确定"后,可手动删除该项目。';
  316. Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);
  317. Exit;
  318. end;
  319. end
  320. else if (iSearch = 0) or (iSearch = -1) then
  321. begin
  322. sHint := sError + '(因网络出错,无法检测[' + FWebBidName_Local + ']在云端是否有更新,本次操作已取消,请重试)。';
  323. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  324. Exit;
  325. end;
  326. Result := True;
  327. end;
  328. var
  329. CurProjectFme: TProjectFrame;
  330. begin
  331. // 打开前先下载更新
  332. Screen.Cursor := crHourGlass;
  333. try
  334. vSel := stdProjects.IDTree.Selected;
  335. vRec := vSel.Rec;
  336. if G_IsCloud then
  337. begin
  338. GetLocalValues(CurRec);
  339. // 以下这段已经包含在MainForm.OpenProject(vRec)中了,但在调用这句之前,网络版要提前用一下。
  340. if MainForm.HasOpened(FID) then
  341. begin
  342. MainForm.LocateProject(FID);
  343. Exit;
  344. end;
  345. if not CanOpen then
  346. Exit;
  347. end;
  348. CurProjectFme := MainForm.OpenProject(vRec);
  349. if G_IsCloud then
  350. begin
  351. // 云版,如果用户在打开项目的过程中,切换界面回项目管理,MainFrom.CurProjectFrame值为nil,后面的调用,包括MainForm.actnCloseProject.Execute都会出错
  352. // 其中由于前面调用的MainForm.LocateProject触发的一系列事件中,调用到了SetPropertyVisible,其中执行了Screen.Cursor := crDefault
  353. // 导致鼠标状态还原,用户可以点击,单机版下测试,属性状态为crHourGlass时,亦可以切换会项目管理
  354. // 按逻辑,CheckFileAndCloudCheckerList这种方法不应在界面,应在控制器,亦不可直接调用MainForm.actnCloseProject.Execute
  355. // 怕按逻辑改动引起更多Bug,故继续错下去,检查MainForm.CurProjectFrame是否正确,并再次禁用鼠标
  356. if CurProjectFme <> MainForm.CurProjectFrame then
  357. begin
  358. Screen.Cursor := crHourGlass;
  359. MainForm.LocateProject(CurProjectFme.ProjectData.ProjectID);
  360. end;
  361. if not MainForm.CurProjectFrame.CheckFileAndCloudChekerList then
  362. begin
  363. sHint := '“'+ FWebBidName_OnLine +'”无法打开,本地与云端审批人不一致。' + #10#13 +
  364. '1、如当前项目审批不通过并已重新开始计量:请回到原电脑操作;' + #10#13 +
  365. '2、审批中/审批完成项目:请删除本地项目重新从云端获取。' + #10#13 +
  366. '如仍然存在同样问题,请联系纵横服务人员。';
  367. Application.MessageBox(PChar(sHint), '文件错误', MB_OK +MB_ICONWARNING);
  368. MainForm.actnCloseProject.Execute;
  369. Exit;
  370. end;
  371. end;
  372. finally
  373. Screen.Cursor := crDefault;
  374. end;
  375. end;
  376. procedure TProjectManagerFrame.actnDeleteExecute(Sender: TObject);
  377. begin
  378. if stdProjects.IDTree.Count = 0 then Exit;
  379. with stdProjects.IDTree.Selected.Rec do
  380. if QuestMessage(Format('确定要删除[%s]吗?', [ValueByName('Name').AsString])) then
  381. begin
  382. Screen.Cursor := crHourGlass;
  383. try
  384. FProjectManagerData.Delete;
  385. finally
  386. Screen.Cursor := crDefault;
  387. end;
  388. end;
  389. end;
  390. procedure TProjectManagerFrame.zgProjectsMouseDown(Sender: TObject;
  391. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  392. begin
  393. if Button = mbRight then
  394. dxpmProjectManager.PopupFromCursorPos
  395. else if (zgProjects.CurCol = 1) and (Button = mbLeft) and (ssDouble in Shift)
  396. and Assigned(stdProjects.IDTree.Selected) then
  397. begin
  398. if IsProject(stdProjects.IDTree.Selected) then
  399. stdProjects.IDTree.Selected.Expand
  400. else
  401. actnOpen.Execute;
  402. end;
  403. end;
  404. function TProjectManagerFrame.ReceiveFile(const AFileName: string; AIsReback: Boolean): Boolean;
  405. var
  406. vRP: TReceiveProject;
  407. vNode: TsdIDTreeNode;
  408. begin
  409. Result := False;
  410. vRP := TReceiveProject.Create(stdProjects.IDTree.Selected);
  411. try
  412. ProjectManager.RefreshSeedID;
  413. if G_IsCloud then
  414. begin
  415. vRP.IsReback := AIsReback;
  416. vRP.Lock := (FWebAuthorID = PHPWeb.UserID) or
  417. ((FWebAuthorID <> PHPWeb.UserID) and (FWebCheckStatusMy <> csChecking));
  418. vRP.WebBidName := FWebBidName_OnLine;
  419. vNode := vRP.ReceiveForLost(AFileName, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner);
  420. if vNode <> nil then
  421. begin
  422. vNode.Rec.BeginUpdate;
  423. vNode.Rec.ValueByName('WebMD5').AsString := FWebMD5_OnLine;
  424. vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
  425. vNode.Rec.EndUpdate;
  426. end;
  427. end
  428. else
  429. vNode := vRP.Receive(AFileName);
  430. finally
  431. case vRP.MessageID of
  432. 0: begin
  433. Result := True;
  434. vNode.LocateInControl;
  435. end;
  436. 1: ErrorMessage('当前标段处于打开状态,未能成功接收,请先关闭标段再次接收。');
  437. 2: ErrorMessage('下载数据与审批状态不一致,未能成功接收,请再次接收。');
  438. 3: ErrorMessage('升级数据失败,未能成功接收,请再次接收。');
  439. end;
  440. vRP.Free;
  441. FProjectManagerData.Save;
  442. end;
  443. end;
  444. // 登录后自动扫描等待我审核的项目 TagC
  445. procedure TProjectManagerFrame.actnReceiveProjectExecute(Sender: TObject);
  446. procedure DoReceiveLocal;
  447. var
  448. sFileName: string;
  449. begin
  450. if SelectFile(sFileName, '.rmf;*.arf') then
  451. begin
  452. ShowProgressHint('正在接收项目并升级数据');
  453. try
  454. ReceiveFile(sFileName);
  455. finally
  456. CloseProgressHint;
  457. end;
  458. end;
  459. end;
  460. var OnCC: TZjCellNotifyEvent;
  461. begin
  462. Screen.Cursor := crHourGlass;
  463. try
  464. if G_IsCloud then
  465. begin
  466. OnCC := zgProjects.OnCurrentChanged;
  467. try
  468. zgProjects.OnCurrentChanged := nil;
  469. DoBatchReceiveOnline(1);
  470. if stdProjects.IDTree.FirstNode <> nil then
  471. stdProjects.IDTree.FirstNode.LocateInControl;
  472. finally
  473. zgProjects.OnCurrentChanged := OnCC;
  474. end;
  475. end
  476. else
  477. DoReceiveLocal;
  478. finally
  479. Screen.Cursor := crDefault;
  480. end;
  481. end;
  482. function TProjectManagerFrame.GetImportProjectName(
  483. const AFileName: string; AParent: TsdIDTreeNode): string;
  484. begin
  485. Result := ExtractSimpleFileName(AFileName);
  486. while FProjectManagerData.ExistProject(Result, AParent) do
  487. if not InputNewProjectName(Result, '导入', AParent) then Abort;
  488. end;
  489. procedure TProjectManagerFrame.actnNewProjectExecute(Sender: TObject);
  490. var
  491. sName: string;
  492. begin
  493. if G_IsCloud then Exit; // 云版线上与本地要保持同步,不允许本地新建
  494. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  495. FProjectManagerData.InsertProject(sName, stdProjects.IDTree.Selected);
  496. end;
  497. procedure TProjectManagerFrame.actnNewSubProjectExecute(Sender: TObject);
  498. var
  499. sName: string;
  500. begin
  501. if G_IsCloud then Exit;
  502. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  503. FProjectManagerData.InsertSubProject(sName, stdProjects.IDTree.Selected);
  504. end;
  505. procedure TProjectManagerFrame.actnNewTenderExecute(Sender: TObject);
  506. function AddAndOpenTender(const ATenderName: string): TsdIDTreeNode;
  507. begin
  508. Result := FProjectManagerData.InsertTender(ATenderName, stdProjects.IDTree.Selected);
  509. MainForm.OpenProject(Result.Rec);
  510. end;
  511. // 网络版新建标段 TagD
  512. procedure NewProjectWithOnline;
  513. var
  514. WebNewTenderForm: TWebNewTenderForm;
  515. sName, sKey, sURL: string;
  516. stnNew: TsdIDTreeNode;
  517. iID, iFolderID, iSubFolderID: Integer;
  518. vRec: TsdDataRecord;
  519. vArr: array of string;
  520. begin
  521. WebNewTenderForm := TWebNewTenderForm.Create(nil);
  522. try
  523. WebNewTenderForm.ShowModal;
  524. if WebNewTenderForm.ModalResult = mrOK then
  525. begin
  526. sKey := WebNewTenderForm.edtKey.Text;
  527. sName := WebNewTenderForm.edtTenderName.Text;
  528. // 同服务器取得联系
  529. iID := -1;
  530. vArr := VarArrayOf(['catid', 'name', 'company', 'phone', 'mobile', 'qq',
  531. 'pname', 'ptype', 'jobs', 'avatar', 'ownuid', 'pnameid', 'ptypeid']);
  532. sURL := Format('%s%d/%s/%s/creatmeasure', [PHPWeb.MeasureURL, PHPWeb.UserID, sName, sKey]); // AnsiToUtf8(sName)
  533. case PHPWeb.Search(sURL, [], [], vArr) of
  534. 1:
  535. begin
  536. iID := StrToInt(vArr[0]);
  537. iFolderID := StrToInt(vArr[11]);
  538. iSubFolderID := StrToInt(vArr[12]);
  539. CheckWebFolders(iFolderID, iSubFolderID, vArr[6], vArr[7]);
  540. end;
  541. 0:
  542. begin
  543. Application.MessageBox(PChar(PHPWeb.PageError('创建标段失败' + '[' + vArr[0] + ']')),
  544. '警告', MB_OK + MB_ICONWARNING);
  545. Exit;
  546. end;
  547. -1:
  548. begin
  549. Application.MessageBox(PChar(PHPWeb.NetError('创建标段失败')),
  550. '警告', MB_OK + MB_ICONWARNING);
  551. Exit;
  552. end;
  553. end;
  554. // 本地创建
  555. stnNew := FProjectManagerData.InsertTender(sName, stdProjects.IDTree.Selected);
  556. // 这里把Web获取的信息存储到项目管理里面。
  557. vRec := stnNew.Rec;
  558. vRec.BeginUpdate;
  559. vRec.ValueByName('WebID').AsInteger := iID;
  560. vRec.ValueByName('WebOwnerID').AsInteger := StrToInt(vArr[10]); // 业主
  561. vRec.ValueByName('WebAuthorID').AsInteger := PHPWeb.UserID; // 编制人
  562. vRec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; // 当前用户,用于只显示自己的项目
  563. vRec.ValueByName('WebKey').AsString := sKey;
  564. vRec.EndUpdate;
  565. GetLocalValues(vRec);
  566. FWebOwnerName := vArr[1];
  567. FWebOwnerCompany := vArr[2];
  568. FWebOwnerRole := vArr[8];
  569. FWebFolder_OnLine := vArr[6];
  570. FWebSubFolder_OnLine := vArr[7];
  571. // WebOwnerImage := vArr[9];
  572. // WebOwnerPhone := vArr[3];
  573. // WebOwnerMobile := vArr[4];
  574. // WebOwnerQQ := vArr[5];
  575. ShowProjectInfoTop(0);
  576. FProjectManagerData.Save;
  577. MainForm.OpenProject(vRec);
  578. end;
  579. finally
  580. WebNewTenderForm.Free;
  581. end;
  582. end;
  583. procedure NewProject;
  584. var
  585. sName: string;
  586. begin
  587. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  588. AddAndOpenTender(sName);
  589. end;
  590. begin
  591. if G_IsCloud then
  592. NewProjectWithOnline
  593. else
  594. NewProject;
  595. end;
  596. procedure TProjectManagerFrame.zgProjectsDrawCellText(ACanvas: TCanvas;
  597. const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
  598. const Text: String; var ADefaultDraw: Boolean);
  599. procedure GetBitmap(AImage: TBitmap; ANode: TsdIDTreeNode);
  600. begin
  601. if Assigned(ANode) and Assigned(ANode.Rec) then
  602. begin
  603. if ANode.Rec.ValueByName('Type').AsInteger = 0 then
  604. if ANode.Expanded and ANode.HasChildren then
  605. MainForm.Images.GetBitmap(34, AImage)
  606. else
  607. MainForm.Images.GetBitmap(34, AImage)
  608. else
  609. MainForm.Images.GetBitmap(11, AImage);
  610. end
  611. else
  612. AImage := nil;
  613. end;
  614. const
  615. rIconWidth = 16;
  616. rIconHeight = 16;
  617. var
  618. Img: TBitmap;
  619. Cell: TZjCell;
  620. rImg: TRect;
  621. vNode: TsdIDTreeNode;
  622. begin
  623. if (ACoord.X = 1) and (ACoord.Y > zgProjects.FixedRowCount - 1) then
  624. begin
  625. Cell := zgProjects.Cells[ACoord.X, ACoord.Y];
  626. Img := TBitmap.Create;
  627. try
  628. vNode := stdProjects.IDTree.Items[ACoord.Y-zgProjects.FixedRowCount];
  629. GetBitmap(Img, vNode);
  630. case Cell.Align of
  631. gaTopLeft, gaTopCenter, gaTopRight:
  632. rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);
  633. gaCenterLeft, gaCenterCenter, gaCenterRight:
  634. rImg := Rect(ARect.Left + 2, ARect.Top + (ARect.Bottom - ARect.Top - rIconHeight) div 2, ARect.Left + rIconWidth, ARect.Bottom - (ARect.Bottom - ARect.Top - rIconHeight) div 2);
  635. gaBottomLeft, gaBottomCenter, gaBottomRight:
  636. rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);
  637. end;
  638. ACanvas.StretchDraw(rImg, Img);
  639. WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)
  640. , 2, 2, Text, Cell.Align, False);
  641. ADefaultDraw := False;
  642. finally
  643. Img.Free;
  644. end;
  645. end;
  646. end;
  647. procedure TProjectManagerFrame.actnNewSubProjectUpdate(Sender: TObject);
  648. begin
  649. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  650. and IsProject(stdProjects.IDTree.Selected)
  651. and (not IsUnEmptyLeafProject(stdProjects.IDTree.Selected));
  652. end;
  653. procedure TProjectManagerFrame.actnNewTenderUpdate(Sender: TObject);
  654. var bCloud: Boolean;
  655. vNode: TsdIDTreeNode;
  656. begin
  657. bCloud := G_IsCloud;
  658. // 只有编制人才能创建新标段?逻辑先后有问题:编制人是在创建标段之后产生的。
  659. // 创建前,当前用户只是一个帐户,它是不是编制人末知,因为它还可以是其它角色。
  660. // 同一帐户在不同的标段可以作为不同的角色。
  661. if bCloud then
  662. begin
  663. TAction(Sender).Enabled := True;
  664. end
  665. else
  666. begin
  667. vNode := stdProjects.IDTree.Selected;
  668. TAction(Sender).Enabled := Assigned(vNode) and IsProject(vNode) and IsLeafProject(vNode);
  669. end;
  670. end;
  671. function TProjectManagerFrame.IsLeafProject(ANode: TsdIDTreeNode): Boolean;
  672. begin
  673. if ANode.HasChildren then
  674. Result := ANode.FirstChild.Rec.ValueByName('Type').AsInteger = 1
  675. else
  676. Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
  677. end;
  678. function TProjectManagerFrame.IsProject(ANode: TsdIDTreeNode): Boolean;
  679. begin
  680. Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
  681. end;
  682. function TProjectManagerFrame.IsUnEmptyLeafProject(
  683. ANode: TsdIDTreeNode): Boolean;
  684. begin
  685. Result := ANode.HasChildren and (ANode.Rec.ValueByName('Type').AsInteger = 1);
  686. end;
  687. procedure TProjectManagerFrame.SetPropertyVisible(AVisible: Boolean);
  688. begin
  689. // 单击刷新项目信息 TagA
  690. if G_IsCloud then
  691. begin
  692. if CurRec = nil then Exit;
  693. pnlTenderProperty.Visible := False;
  694. pnlWeb.Visible := AVisible;
  695. if AVisible then
  696. begin
  697. CreateProgress('云端读取项目信息');
  698. try
  699. ShowProjectInfoTopAndCheckers;
  700. finally
  701. CloseProgress;
  702. end;
  703. end;
  704. end
  705. else
  706. begin
  707. pnlWeb.Visible := False;
  708. pnlTenderProperty.Visible := AVisible;
  709. sprProperty.Visible := AVisible;
  710. end;
  711. end;
  712. procedure TProjectManagerFrame.zgProjectsCurrentChanged(Sender: TObject;
  713. Col, Row: Integer);
  714. begin
  715. if G_IsCloud then
  716. begin
  717. if CurRec <> nil then
  718. begin
  719. // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
  720. // if FID <> CurRec.ValueByName('ID').AsInteger then
  721. SetPropertyVisible(CurRec.ValueByName('Type').AsInteger = 1);
  722. // OnCurrentChanged取得的 CurRec.ValueByName() 值并不总是可靠,这里加保险。
  723. // 如调用locateInControl后,执行到这里取得的CurRec.ValueByName('ID')值还是上一条的。
  724. if (CurRec.ValueByName('Type').AsInteger = 1) and (not pnlWeb.Visible) then
  725. pnlWeb.Visible := True;
  726. end;
  727. end;
  728. end;
  729. procedure TProjectManagerFrame.actnSubmitProjectUpdate(Sender: TObject);
  730. begin
  731. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  732. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1)
  733. and (stdProjects.IDTree.Selected.Rec.ValueByName('AuditStatus').AsInteger < iMaxStageCount-1);
  734. end;
  735. procedure TProjectManagerFrame.actnReplyProjectUpdate(Sender: TObject);
  736. begin
  737. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  738. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  739. end;
  740. procedure TProjectManagerFrame.actnRenameExecute(Sender: TObject);
  741. function CanRename(ARec: TsdDataRecord; const ANewName: string): Boolean;
  742. var
  743. sURL: string;
  744. iRename: Integer;
  745. vArr: array [0..0] of string;
  746. begin
  747. Result := True;
  748. if not G_IsCloud then Exit;
  749. // 云版 重命名须确保同步服务器
  750. sURL := Format('%stender/%d/%s/update', [PHPWeb.MeasureURL, ARec.ValueByName('WebID').AsInteger, ANewName]);
  751. iRename := PHPWeb.Search(sURL, [], [], vArr);
  752. Result := iRename = 1;
  753. case iRename of
  754. 1: ShowMessage('新的标段名称已同步到服务器!');
  755. 0: Application.MessageBox(PChar(PHPWeb.PageError('重命名同步到云端失败' + '[' + vArr[0] + ']')),
  756. '警告', MB_OK + MB_ICONWARNING);
  757. -1: Application.MessageBox(PChar(PHPWeb.NetError('重命名同步到云端失败')),
  758. '警告', MB_OK + MB_ICONWARNING);
  759. end;
  760. end;
  761. var
  762. stnNode: TsdIDTreeNode;
  763. sName: string;
  764. begin
  765. stnNode := stdProjects.IDTree.Selected;
  766. sName := stnNode.Rec.ValueByName('Name').AsString;
  767. if not Assigned(OpenProjectManager.FindProjectData(stnNode.ID)) then
  768. begin
  769. if InputNewProjectName(sName, '重命名', stnNode.Parent, stnNode.ID) then
  770. begin
  771. if (sName <> stnNode.Rec.ValueByName('Name').AsString) and CanRename(stnNode.Rec, sName) then
  772. begin
  773. stnNode.Rec.ValueByName('Name').AsString := sName;
  774. ProjectManager.Save;
  775. end;
  776. end;
  777. end
  778. else
  779. ErrorMessage(Format('项目[%s]已经打开,无法重命名!', [sName]));
  780. end;
  781. procedure TProjectManagerFrame.actnOpenUpdate(Sender: TObject);
  782. begin
  783. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  784. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  785. end;
  786. procedure TProjectManagerFrame.actnImportExecute(Sender: TObject);
  787. procedure ImportTender(const AFileName, AProjectName: string);
  788. var
  789. Importor: TTenderImport;
  790. begin
  791. Importor := TTenderImport.Create(stdProjects.IDTree.Selected,
  792. AProjectName, AFileName);
  793. try
  794. Importor.Execute;
  795. finally
  796. Importor.Free;
  797. end;
  798. end;
  799. procedure ImportProject(const AFileName, AProjectName: string);
  800. var
  801. Importor: TProjectImport;
  802. begin
  803. Importor := TProjectImport.Create(stdProjects.IDTree.Selected,
  804. AProjectName, AFileName);
  805. try
  806. Importor.Execute;
  807. finally
  808. Importor.Free;
  809. end;
  810. end;
  811. var
  812. sFileName, sProjectName: string;
  813. vCur: TsdIDTreeNode;
  814. begin
  815. if SelectFile(sFileName, '.mtf;*.mpf') then
  816. begin
  817. vCur := stdProjects.IDTree.Selected;
  818. if Assigned(vCur) then
  819. begin
  820. if SameText(ExtractFileExt(sFileName), '.mtf')
  821. and (vCur.Rec.ValueByName('Type').AsInteger = 0) then
  822. sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected)
  823. else
  824. sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected.Parent);
  825. end
  826. else
  827. sProjectName := GetImportProjectName(sFileName, vCur);
  828. Screen.Cursor := crHourGlass;
  829. try
  830. if SameText(ExtractFileExt(sFileName), '.mtf') then
  831. ImportTender(sFileName, sProjectName)
  832. else
  833. ImportProject(sFileName, sProjectName);
  834. finally
  835. Screen.Cursor := crDefault;
  836. end;
  837. end;
  838. FProjectManagerData.Save;
  839. end;
  840. procedure TProjectManagerFrame.actnExportExecute(Sender: TObject);
  841. procedure ExportTender(ANode: TsdIDTreeNode);
  842. var
  843. Exportor: TTenderExport;
  844. sFileName, sHint: string;
  845. bExpAtch: Boolean;
  846. iCount: Integer;
  847. begin
  848. bExpAtch := False;
  849. sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mtf';
  850. if SaveFile(sFileName, '.mtf') then
  851. begin
  852. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  853. Exit;
  854. Screen.Cursor := crHourGlass;
  855. try
  856. Exportor := TTenderExport.Create(ANode.Rec, sFileName);
  857. try
  858. { if not G_IsCloud then
  859. begin
  860. iCount := FileCount(CurRecAttachmentPath);
  861. if iCount > 1 then // 排除管理文件库
  862. begin
  863. sHint := Format('本标段包含 %d 个附件,是否将附件一起导出?', [iCount - 1]);
  864. bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
  865. end;
  866. end; } // FFFFF
  867. Exportor.Execute(bExpAtch);
  868. finally
  869. Exportor.Free;
  870. end;
  871. finally
  872. Screen.Cursor := crDefault;
  873. end;
  874. end;
  875. end;
  876. procedure ExportProject(ANode: TsdIDTreeNode);
  877. var
  878. Exportor: TProjectExport;
  879. sFileName, sHint: string;
  880. bExpAtch: Boolean;
  881. iCount: Integer;
  882. begin
  883. sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mpf';
  884. if SaveFile(sFileName, '.mpf') then
  885. begin
  886. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  887. Exit;
  888. Screen.Cursor := crHourGlass;
  889. try
  890. bExpAtch := False;
  891. { if not G_IsCloud then
  892. begin
  893. iCount := AttachmentFileCountsWithoutManageFile(ANode);
  894. if iCount > 0 then
  895. begin
  896. sHint := Format('本建设项目共包含 %d 个附件,是否将附件一起导出?', [iCount]);
  897. bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
  898. end;
  899. end; } // FFFFF
  900. Exportor := TProjectExport.Create(ANode, sFileName, bExpAtch);
  901. try
  902. Exportor.Execute;
  903. finally
  904. Exportor.Free;
  905. end;
  906. finally
  907. Screen.Cursor := crDefault;
  908. end;
  909. end;
  910. end;
  911. var
  912. stnNode: TsdIDTreeNode;
  913. begin
  914. stnNode := stdProjects.IDTree.Selected;
  915. if stnNode.Rec.ValueByName('Type').AsInteger = 1 then
  916. begin
  917. ExportTender(stnNode);
  918. end
  919. else
  920. ExportProject(stnNode);
  921. end;
  922. procedure TProjectManagerFrame.actnDeleteUpdate(Sender: TObject);
  923. begin
  924. if Assigned(stdProjects.IDTree.Selected) then
  925. TAction(Sender).Enabled := not CheckOpened(stdProjects.IDTree.Selected)
  926. else
  927. TAction(Sender).Enabled := False;
  928. end;
  929. function TProjectManagerFrame.CheckOpened(ANode: TsdIDTreeNode): Boolean;
  930. var
  931. iChild: Integer;
  932. begin
  933. Result := False;
  934. if ANode.Rec.ValueByName('Type').AsInteger = 1 then
  935. Result := OpenProjectManager.ProjectIndex(ANode.ID) > -1
  936. else
  937. begin
  938. if not ANode.HasChildren then
  939. Result := False
  940. else
  941. begin
  942. for iChild := 0 to ANode.ChildCount - 1 do
  943. Result := Result or CheckOpened(ANode.ChildNodes[iChild]);
  944. end
  945. end;
  946. end;
  947. procedure TProjectManagerFrame.ShowProjectInfoTopAndCheckers;
  948. var
  949. vPSArr: TStrArr;
  950. vCArr: TOVArr; // Checkers
  951. sPicPath, sURL: string;
  952. procedure ShowProjectCheckers;
  953. var i, j, k, n: Integer;
  954. vOwner: array of string; // 业主信息
  955. procedure AddCheckerFrame(AType: TCheckerFrameType; AArr: array of string);
  956. var vChecker: TOrderCheckerFrame;
  957. begin
  958. vChecker := TOrderCheckerFrame.Create(self);
  959. FCheckerFrames.Add(vChecker);
  960. vChecker.Owner := Self;
  961. sbChecker.VertScrollBar.Range := sbChecker.VertScrollBar.Range + vChecker.Height;
  962. sbChecker.Height := Min(sbChecker.Height + vChecker.Height, pnlWeb.Height - pnlProject.Height);
  963. vChecker.Parent := sbChecker;
  964. vChecker.Top := FCurPos;
  965. FCurPos := FCurPos + vChecker.Height;
  966. vChecker.Align := alTop;
  967. sPicPath := PHPWeb.UserPath + '1_' + AArr[0] + '.jpg';
  968. PHPWeb.DownFile(AArr[4], sPicPath);
  969. vChecker.Init(AType, StrToInt(AArr[0]), AArr[1], AArr[3],
  970. AArr[2], sPicPath, AArr[6], TCheckStatus(StrToInt(AArr[5])-1), AArr[8], StrToInt(AArr[7]));
  971. vChecker.Name := 'ProjectOrderFrame' + AArr[0];
  972. end;
  973. begin
  974. sbChecker.Height := 0;
  975. FCurPos := 0;
  976. n := Length(vCArr[Low(vCArr)]);
  977. SetLength(vOwner, n);
  978. sbChecker.VertScrollBar.Range := 0;
  979. for i := Low(vCArr) to High(vCArr) do
  980. begin
  981. if StrToInt(vCArr[i, 0]) = PHPWeb.UserID then
  982. FWebCheckStatusMy := TCheckStatus(StrToInt(vCArr[i, 5])-1);
  983. if StrToInt(vCArr[i, 0]) = FWebOwnerID then
  984. begin
  985. for j := 0 to n - 1 do
  986. vOwner[j] := vCArr[i, j];
  987. Continue;
  988. end;
  989. AddCheckerFrame(cftChecker, vCArr[i]);
  990. end;
  991. if vOwner[0] <> '' then
  992. AddCheckerFrame(cftOwner, vOwner);
  993. for k := 0 to sbChecker.ControlCount - 1 do
  994. TOrderCheckerFrame(sbChecker.Controls[k]).Order := k + 1;
  995. OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner);
  996. end;
  997. begin
  998. FCheckerFrames.Clear;
  999. GetLocalValues(CurRec);
  1000. if FWebID = 0 then Exit;
  1001. SetLength(vPSArr, 8);
  1002. sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
  1003. SetLength(FCheckers, 0);
  1004. if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then
  1005. begin
  1006. FCheckers := vCArr;
  1007. LockWindowUpdate(pnlWeb.Handle);
  1008. try
  1009. FPhaseNo := StrToInt(vPSArr[0]);
  1010. FWebCheckStatusProject := TCheckStatus(StrToInt(vPSArr[1])-1);
  1011. FPhaseTotal := StrToInt(vPSArr[2]);
  1012. FWebFolder_OnLine := vPSArr[3];
  1013. FWebSubFolder_OnLine := vPSArr[4];
  1014. FWebOwnerName := vPSArr[5];
  1015. FWebOwnerCompany := vPSArr[6];
  1016. FWebOwnerRole := vPSArr[7];
  1017. ShowProjectInfoTop;
  1018. ShowProjectCheckers;
  1019. finally
  1020. LockWindowUpdate(0);
  1021. end;
  1022. end
  1023. else
  1024. begin
  1025. FPhaseNo := 0;
  1026. FWebCheckStatusProject := csNotBegin;
  1027. FPhaseTotal := 0;
  1028. FWebFolder_OnLine := '';
  1029. FWebSubFolder_OnLine := '';
  1030. FWebOwnerName := '';
  1031. FWebOwnerCompany := '';
  1032. FWebOwnerRole := '';
  1033. ShowProjectInfoTop;
  1034. sbChecker.Height := 0;
  1035. end;
  1036. end;
  1037. procedure TProjectManagerFrame.ShowProjectInfoTop(AType: Integer);
  1038. procedure ShowOwner;
  1039. begin
  1040. lblBidName.Caption := FWebBidName_Local;
  1041. lblBidName.Update;
  1042. lblProjName.Caption := FWebFolder_OnLine;
  1043. lblProjName.Update;
  1044. lblWebProjCtgyName.Caption := FWebSubFolder_OnLine;
  1045. lblWebProjCtgyName.Update;
  1046. lblOnwerName.Caption := FWebOwnerName;
  1047. lblOnwerName.Update;
  1048. lblOnwerCompany.Caption := Format('-%s)', [FWebOwnerCompany]);
  1049. lblOnwerCompany.Update;
  1050. lblOnwerCompany.Left := lblOnwerName.Left + lblOnwerName.Width;
  1051. end;
  1052. procedure ShowStatus(ANo: Integer; AState: TCheckStatus);
  1053. begin
  1054. lblPeriod.Caption := Format('第%d期', [ANo]);
  1055. lblPeriod.Update;
  1056. lblPeriodState.Caption := CheckStatusNames[AState];
  1057. lblPeriodState.Font.Color := CheckStatusColors[AState];
  1058. lblPeriodState.Update;
  1059. lblPeriodState.Left := lblPeriod.Left + lblPeriod.Width + 5;
  1060. lblPeriodTotal.Caption := Format('(共%d期)', [ANo]);
  1061. lblPeriodTotal.Update;
  1062. lblPeriodTotal.Left := lblPeriodState.Left + lblPeriodState.Width + 3;
  1063. end;
  1064. begin
  1065. GetLocalValues(CurRec);
  1066. case AType of
  1067. -2:
  1068. begin
  1069. lblPeriod.Caption := '正在从云端读取状态信息...';
  1070. lblPeriod.Update;
  1071. end;
  1072. -1:
  1073. begin
  1074. ShowOwner;
  1075. ShowStatus(FPhaseNo, FWebCheckStatusProject);
  1076. end;
  1077. 0:
  1078. begin
  1079. ShowOwner;
  1080. ShowStatus(0, csNotBegin);
  1081. end;
  1082. end;
  1083. end;
  1084. // 检查后,应该定位到最后一层目录,不应该回到原先的选择节点。否则从网络拉下来的项目无法组织正确的树结构。
  1085. procedure TProjectManagerFrame.CheckWebFolders(AFolderID, ASubFolderID: Integer;
  1086. AFolderName, ASubFolderName: string);
  1087. var
  1088. vTree: TsdIDTree;
  1089. vNode, vSubNode: TsdIDTreeNode;
  1090. i: Integer;
  1091. sName: string;
  1092. iUserID, iWebID, iWebFolderLevel: Integer;
  1093. bExist, bSubExist, bModified: Boolean;
  1094. begin
  1095. bExist := False;
  1096. bSubExist := False;
  1097. bModified := False;
  1098. vTree := stdProjects.IDTree;
  1099. for i := 0 to vTree.Count - 1 do
  1100. begin
  1101. vNode := vTree.Items[i];
  1102. sName := vNode.Rec.ValueByName('Name').AsString;
  1103. iUserID := vNode.Rec.ValueByName('WebUserID').AsInteger;
  1104. iWebID := vNode.Rec.ValueByName('WebID').AsInteger;
  1105. iWebFolderLevel := vNode.Rec.ValueByName('WebFolderLevel').AsInteger;
  1106. if (iWebID = AFolderID) and (iWebFolderLevel = G_WFL_ProjName) and (iUserID = PHPWeb.UserID) then
  1107. begin
  1108. bExist := True;
  1109. vNode.LocateInControl;
  1110. if not SameText(sName, AFolderName) then
  1111. begin
  1112. vNode.Rec.ValueByName('Name').AsString := AFolderName;
  1113. bModified := True;
  1114. end;
  1115. Break;
  1116. end;
  1117. end;
  1118. if not bExist then
  1119. begin
  1120. vNode := vTree.Items[0];
  1121. if Assigned(vNode) then
  1122. vNode.LocateInControl;
  1123. vNode := FProjectManagerData.InsertProject(AFolderName, stdProjects.IDTree.Selected, AFolderID, G_WFL_ProjName);
  1124. vNode.LocateInControl;
  1125. end;
  1126. for i := 0 to vNode.ChildCount - 1 do
  1127. begin
  1128. vSubNode := vNode.ChildNodes[i];
  1129. sName := vSubNode.Rec.ValueByName('Name').AsString;
  1130. iUserID := vSubNode.Rec.ValueByName('WebUserID').AsInteger;
  1131. iWebID := vSubNode.Rec.ValueByName('WebID').AsInteger;
  1132. iWebFolderLevel := vSubNode.Rec.ValueByName('WebFolderLevel').AsInteger;
  1133. if (iWebID = ASubFolderID) and (iWebFolderLevel = G_WFL_BidType) and (iUserID = PHPWeb.UserID) then
  1134. begin
  1135. bSubExist := True;
  1136. vSubNode.LocateInControl;
  1137. if not SameText(sName, ASubFolderName) then
  1138. begin
  1139. vSubNode.Rec.ValueByName('Name').AsString := ASubFolderName;
  1140. bModified := True;
  1141. end;
  1142. Break;
  1143. end;
  1144. end;
  1145. if not bSubExist then
  1146. begin
  1147. vNode.LocateInControl;
  1148. vNode := FProjectManagerData.InsertSubProject(ASubFolderName, stdProjects.IDTree.Selected, ASubFolderID, G_WFL_BidType);
  1149. vNode.LocateInControl;
  1150. end;
  1151. if bModified then
  1152. ProjectManager.Save;
  1153. end;
  1154. function TProjectManagerFrame.Rec(AProjectID: Integer): TsdDataRecord;
  1155. var i: Integer;
  1156. vTree: TsdIDTree;
  1157. begin
  1158. vTree := stdProjects.IDTree;
  1159. if vTree.Selected.Rec.ValueByName('ID').AsInteger = AProjectID then
  1160. begin
  1161. Result := stdProjects.IDTree.Selected.Rec;
  1162. Exit;
  1163. end;
  1164. for i := 0 to vTree.Count - 1 do
  1165. begin
  1166. if vTree.Items[i].Rec.ValueByName('ID').AsInteger = AProjectID then
  1167. begin
  1168. Result := vTree.Items[i].Rec;
  1169. vTree.Items[i].LocateInControl;
  1170. Break;
  1171. end;
  1172. end;
  1173. end;
  1174. destructor TProjectManagerFrame.Destroy;
  1175. begin
  1176. FCheckerFrames.Free;
  1177. inherited;
  1178. end;
  1179. procedure TProjectManagerFrame.DoBatchReceiveOnline(ARequestType: Integer);
  1180. var
  1181. sURL, sCheckersURL, sHint: string;
  1182. vArr: TOVArr;
  1183. i, iFolderID, iSubFolderID: Integer;
  1184. vPSArr: TStrArr;
  1185. vCArr: TOVArr; // Checkers
  1186. begin
  1187. // 查询等待我审核的标段文件,杰哥说分三种:①业主未审核 ②业主审核中 ③审核人审核中 (为什么加①?问杰哥)
  1188. case PHPWeb.Search(PHPWeb.MeasureURL + 'user/get/audit/project', ['audituid', 'RequestType'],
  1189. [IntToStr(PHPWeb.UserID), IntToStr(ARequestType)], vArr) of
  1190. 1:
  1191. begin
  1192. CreateProgress('正在从云端下载新项目');
  1193. try
  1194. for i := Low(vArr) to High(vArr) do
  1195. begin
  1196. sURL := vArr[i, 0];
  1197. FWebFolder_OnLine := vArr[i, 1];
  1198. FWebSubFolder_OnLine := vArr[i, 2];
  1199. FWebMD5_OnLine := vArr[i, 3];
  1200. FWebID := StrToInt(vArr[i, 5]);
  1201. iFolderID := StrToInt(vArr[i, 6]);
  1202. iSubFolderID := StrToInt(vArr[i, 7]);
  1203. FWebCheckStatusMy := TCheckStatus(StrToInt(vArr[i, 8])-1); // vArr[i, 4]项目审核状态;vArr[i, 8]当前登陆用户的审核状态
  1204. FWebAuthorID := StrToInt(vArr[i, 9]);
  1205. FWebBidName_OnLine := vArr[i, 10];
  1206. FWebMD5_Local := LocalMD5(PHPWeb.UserID, FWebID);
  1207. CheckWebFolders(iFolderID, iSubFolderID, FWebFolder_OnLine, FWebSubFolder_OnLine);
  1208. CheckBidName(PHPWeb.UserID, FWebID, FWebBidName_OnLine);
  1209. if FWebMD5_OnLine <> FWebMD5_Local then
  1210. begin
  1211. sCheckersURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
  1212. if PHPWeb.Search(sCheckersURL, [''], [''], 3, vPSArr, vCArr) = 1 then
  1213. OnLineChecker(vCArr, FOnLineCheckerBegin, FOnLineCheckerEnd, FOnLineCheckerEndIsOwner)
  1214. else
  1215. begin
  1216. FOnLineCheckerBegin := 0;
  1217. FOnLineCheckerEnd := 0;
  1218. end;
  1219. if not FileDownAndReceive(sURL, 1) then Exit;
  1220. end;
  1221. end;
  1222. BubbleSortProjects;
  1223. finally
  1224. CloseProgress;
  1225. end;
  1226. end;
  1227. 0:
  1228. begin
  1229. sHint := 'Web页返回错误(000J),无法查询云端项目的更新情况,请重试!';
  1230. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  1231. Exit;
  1232. end;
  1233. -1:
  1234. begin
  1235. sHint := '网络较差,服务器断开连接,无法查询云端项目的更新情况,请重试!';
  1236. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  1237. Exit;
  1238. end;
  1239. end;
  1240. end;
  1241. function TProjectManagerFrame.ImportFile(const AFileName: string; AFileMD5: string): Boolean;
  1242. var
  1243. vImport: TTenderImport;
  1244. vNode: TsdIDTreeNode;
  1245. begin
  1246. Result := False;
  1247. vNode := stdProjects.IDTree.Selected;
  1248. vImport := TTenderImport.Create(vNode, '', AFileName);
  1249. try
  1250. try
  1251. vImport.ImportToSelect;
  1252. vNode.LocateInControl;
  1253. Result := True;
  1254. except
  1255. Result := False;
  1256. end;
  1257. finally
  1258. vImport.Free;
  1259. vNode.Rec.BeginUpdate;
  1260. vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5;
  1261. vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
  1262. vNode.Rec.EndUpdate;
  1263. FProjectManagerData.Save;
  1264. end;
  1265. end;
  1266. procedure TProjectManagerFrame.actnOpenBackupFolderExecute(
  1267. Sender: TObject);
  1268. var
  1269. stnNode: TsdIDTreeNode;
  1270. begin
  1271. stnNode := stdProjects.IDTree.Selected;
  1272. if stnNode.Rec.ValueByName('BackupFolder').AsString = '' then
  1273. TipMessage('该项目暂无备份数据!')
  1274. else
  1275. ShellExecute(Handle, 'open', 'Explorer.exe',
  1276. PChar(FProjectManagerData.BackupPath(stnNode.ID)), nil, 1);
  1277. end;
  1278. procedure TProjectManagerFrame.actnRenameUpdate(Sender: TObject);
  1279. var
  1280. Rec: TsdDataRecord;
  1281. bNet, bEnabled: Boolean;
  1282. begin
  1283. if Assigned(stdProjects.IDTree.Selected) and Assigned(stdProjects.IDTree.Selected.Rec) then
  1284. begin
  1285. bEnabled := True;
  1286. Rec := stdProjects.IDTree.Selected.Rec;
  1287. bNet := G_IsCloud;
  1288. if bNet then
  1289. begin
  1290. bEnabled := (Rec.ValueByName('Type').AsInteger = 1) and
  1291. (Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID);
  1292. end;
  1293. end
  1294. else
  1295. bEnabled := False;
  1296. if bEnabled <> TAction(Sender).Enabled then
  1297. TAction(Sender).Enabled := bEnabled;
  1298. end;
  1299. procedure TProjectManagerFrame.CheckBidName(AID: Integer; ANewBidName: string);
  1300. var vNode: TsdIDTreeNode;
  1301. begin
  1302. vNode := stdProjects.IDTree.FindNode(AID);
  1303. if vNode = nil then Exit;
  1304. if vNode.Rec.ValueByName('Name').AsString <> ANewBidName then
  1305. begin
  1306. vNode.Rec.ValueByName('Name').AsString := ANewBidName;
  1307. ProjectManager.Save;
  1308. end;
  1309. end;
  1310. procedure TProjectManagerFrame.DoBatchReceiveAllOnline;
  1311. var
  1312. OnCC: TZjCellNotifyEvent;
  1313. begin
  1314. OnCC := zgProjects.OnCurrentChanged;
  1315. try
  1316. zgProjects.OnCurrentChanged := nil;
  1317. DoBatchReceiveOnline(2);
  1318. if stdProjects.IDTree.FirstNode <> nil then
  1319. stdProjects.IDTree.FirstNode.LocateInControl;
  1320. finally
  1321. zgProjects.OnCurrentChanged := OnCC;
  1322. end;
  1323. end;
  1324. procedure TProjectManagerFrame.GetLocalValues(ARec: TsdDataRecord);
  1325. begin
  1326. if not Assigned(ARec) then
  1327. begin
  1328. ClearLocalValues;
  1329. Exit;
  1330. end;
  1331. // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
  1332. // if ARec.ValueByName('ID').AsInteger <> FID then
  1333. begin
  1334. FID := ARec.ValueByName('ID').AsInteger;
  1335. FWebID := ARec.ValueByName('WebID').AsInteger;
  1336. FWebAuthorID := ARec.ValueByName('WebAuthorID').AsInteger;
  1337. FWebOwnerID := ARec.ValueByName('WebOwnerID').AsInteger;
  1338. FWebMD5_Local := ARec.ValueByName('WebMD5').AsString;
  1339. FWebBidName_Local := ARec.ValueByName('Name').AsString;
  1340. end;
  1341. end;
  1342. procedure TProjectManagerFrame.GetLocalValues(AUserID, AWebID: Integer);
  1343. var i: Integer;
  1344. vTree: TsdIDTree;
  1345. vRec: TsdDataRecord;
  1346. begin
  1347. ClearLocalValues; // 先清空,以防没找到。
  1348. if (CurRec <> nil) and
  1349. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1350. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1351. (CurRec.ValueByName('Type').AsInteger = 1) then
  1352. begin
  1353. GetLocalValues(CurRec);
  1354. Exit;
  1355. end;
  1356. vTree := stdProjects.IDTree;
  1357. for i := 0 to vTree.Count - 1 do
  1358. begin
  1359. vRec := vTree.Items[i].Rec;
  1360. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1361. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1362. (vRec.ValueByName('Type').AsInteger = 1) then
  1363. begin
  1364. GetLocalValues(vRec);
  1365. Break;
  1366. end;
  1367. end;
  1368. end;
  1369. procedure TProjectManagerFrame.ClearLocalValues;
  1370. begin
  1371. FID := -1;
  1372. FWebID := -1;
  1373. FWebAuthorID := -1;
  1374. FWebOwnerID := -1;
  1375. FWebMD5_Local := '';
  1376. FWebBidName_Local := '';
  1377. end;
  1378. function TProjectManagerFrame.LocalMD5(AUserID, AWebID: Integer): string;
  1379. var i: Integer;
  1380. vTree: TsdIDTree;
  1381. vRec: TsdDataRecord;
  1382. begin
  1383. Result := '本地无MD5码';
  1384. if (CurRec <> nil) and
  1385. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1386. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1387. (CurRec.ValueByName('Type').AsInteger = 1) then
  1388. begin
  1389. Result := CurRec.ValueByName('WebMD5').AsString;
  1390. Exit;
  1391. end;
  1392. vTree := stdProjects.IDTree;
  1393. for i := 0 to vTree.Count - 1 do
  1394. begin
  1395. vRec := vTree.Items[i].Rec;
  1396. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1397. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1398. (vRec.ValueByName('Type').AsInteger = 1) then
  1399. begin
  1400. Result := vRec.ValueByName('WebMD5').AsString;
  1401. Break;
  1402. end;
  1403. end;
  1404. end;
  1405. function TProjectManagerFrame.CurRec: TsdDataRecord;
  1406. begin
  1407. if stdProjects.IDTree.Selected = nil then
  1408. Result := nil
  1409. else
  1410. Result := stdProjects.IDTree.Selected.Rec;
  1411. end;
  1412. procedure TProjectManagerFrame.CheckBidName(AUserID, AWebID: Integer;
  1413. ANewBidName: string);
  1414. var i: Integer;
  1415. vTree: TsdIDTree;
  1416. vRec: TsdDataRecord;
  1417. begin
  1418. if (CurRec <> nil) and
  1419. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1420. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1421. (CurRec.ValueByName('Type').AsInteger = 1) then
  1422. begin
  1423. if (CurRec.ValueByName('Name').AsString <> ANewBidName) then
  1424. begin
  1425. CurRec.ValueByName('Name').AsString := ANewBidName;
  1426. ProjectManager.Save;
  1427. end;
  1428. Exit;
  1429. end;
  1430. vTree := stdProjects.IDTree;
  1431. for i := 0 to vTree.Count - 1 do
  1432. begin
  1433. vRec := vTree.Items[i].Rec;
  1434. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1435. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1436. (vRec.ValueByName('Type').AsInteger = 1) then
  1437. begin
  1438. if vRec.ValueByName('Name').AsString <> ANewBidName then
  1439. begin
  1440. vRec.ValueByName('Name').AsString := ANewBidName;
  1441. ProjectManager.Save;
  1442. end;
  1443. Break;
  1444. end;
  1445. end;
  1446. end;
  1447. function TProjectManagerFrame.CurRecAttachmentPath: string;
  1448. begin
  1449. if G_IsCloud then
  1450. Result := PHPWeb.WebPath + 'Projects\' + CurRec.ValueByName('WebID').AsString + '\Attachment\'
  1451. else
  1452. Result := GetMyProjectsFilePath + 'Attachment\' + CurRec.ValueByName('FileName').AsString + '\';
  1453. end;
  1454. function TProjectManagerFrame.AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
  1455. function GetCount(ANode: TsdIDTreeNode): Integer;
  1456. var sPath: string;
  1457. begin
  1458. if not Assigned(ANode) then Exit;
  1459. Result := 0;
  1460. if ANode.Rec.ValueByName('Type').AsInteger = 0 then
  1461. Result := Result + 0
  1462. else
  1463. begin
  1464. sPath := GetMyProjectsFilePath + 'Attachment\' + ANode.Rec.ValueByName('FileName').AsString + '\';
  1465. Result := Result + FileCount(sPath, '.*') - 1;
  1466. end;
  1467. if Assigned(ANode.FirstChild) then
  1468. Result := Result + GetCount(ANode.FirstChild);
  1469. if Assigned(ANode.NextSibling) then
  1470. Result := Result + GetCount(ANode.NextSibling);
  1471. end;
  1472. begin
  1473. if not Assigned(ANode) then Exit;
  1474. if Assigned(ANode.FirstChild) then
  1475. Result := GetCount(ANode.FirstChild)
  1476. else
  1477. Result := 0;
  1478. end;
  1479. procedure TProjectManagerFrame.BubbleSortProjects;
  1480. // 不能排最顶层
  1481. procedure BubbleSort(ANode: TsdIDTreeNode);
  1482. var n, t, c, temp: Integer;
  1483. bSwap: Boolean;
  1484. vNode1, vNode2, vTempNode: TsdIDTreeNode;
  1485. begin
  1486. if ANode = nil then Exit;
  1487. // if ANode.Rec.ValueByName('WebFolderLevel').AsInteger = G_WFL_ProjName then Exit;
  1488. n := ANode.ChildCount;
  1489. for t := 1 to n - 1 do
  1490. begin
  1491. bSwap := False;
  1492. for c := 1 to (n - t) do
  1493. begin
  1494. vNode1 := ANode.ChildNodes[c - 1];
  1495. vNode2 := ANode.ChildNodes[c];
  1496. if AnsiCompareStr(vNode1.Rec.ValueByName('Name').AsString,
  1497. vNode2.Rec.ValueByName('Name').AsString) = 1 then
  1498. begin
  1499. vNode1.DownMove;
  1500. bSwap := True;
  1501. end;
  1502. end;
  1503. if bSwap = False then Break;
  1504. end;
  1505. if Assigned(ANode.FirstChild) then
  1506. BubbleSort(ANode.FirstChild);
  1507. if Assigned(ANode.NextSibling) then
  1508. BubbleSort(ANode.NextSibling);
  1509. end;
  1510. begin
  1511. BubbleSort(stdProjects.IDTree.FirstNode);
  1512. end;
  1513. procedure TProjectManagerFrame.zgProjectsShowHint(var HintStr: String;
  1514. var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
  1515. var
  1516. vCell: TZjCell;
  1517. vNode: TsdIDTreeNode;
  1518. iLevelWidth: Integer;
  1519. rText: TRect;
  1520. procedure CalcTextRect(var R: TRect);
  1521. var
  1522. DC: HDC;
  1523. iTextHeight: Integer;
  1524. begin
  1525. DC := CreateCompatibleDC(0);
  1526. try
  1527. SelectObject(DC, vCell.Font.Handle);
  1528. iTextHeight := DrawText(DC, PChar(vCell.Text), Length(vCell.Text), R, DT_SINGLELINE or DT_VCenter
  1529. or DT_NOCLIP or DT_CALCRECT);
  1530. finally
  1531. DeleteDC(DC);
  1532. end;
  1533. end;
  1534. begin
  1535. if (ACoord.Y < 1) and (ACoord.X <> 1) then Exit;
  1536. vCell := zgProjects.Cells[ACoord.X, ACoord.Y];
  1537. with HintInfo do
  1538. begin
  1539. vNode := stdProjects.IDTree.Items[ACoord.Y - 1];
  1540. if not Assigned(vNode) then Exit;
  1541. iLevelWidth := (vNode.Level + 1) * 20 + 16;
  1542. rText := CursorRect;
  1543. CalcTextRect(rText);
  1544. if (rText.Right - rText.Left + iLevelWidth > CursorRect.Right - CursorRect.Left) or
  1545. (rText.Right > ClientWidth) then
  1546. begin
  1547. CanShow := True;
  1548. HintStr := vCell.Text;
  1549. GetCursorPos(HintPos);
  1550. end;
  1551. end;
  1552. end;
  1553. function TProjectManagerFrame.FileDownAndReceive(ADownURL: string; AReceiveKind: Integer): Boolean;
  1554. var sLocalFile, sHint: string;
  1555. bCanImp: Boolean;
  1556. vFileCheck: TTenderFileChecker;
  1557. begin
  1558. Result := False;
  1559. // 下载
  1560. sLocalFile := PHPWeb.UserPath + ExtractFileName(ADownURL);
  1561. if not PHPWeb.DownFile(ADownURL, sLocalFile) then
  1562. begin
  1563. sHint := Format('云端已找到 [%s] 的新文件,但由于网络原因下载失败!请重试!', [FWebBidName_Local]);
  1564. Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
  1565. Exit;
  1566. end;
  1567. // 接收前先检验原报文件是否正确(审核不通过打回)
  1568. if AReceiveKind = 2 then
  1569. begin
  1570. // 有时原报文件出错:包含了1审2审的数据。
  1571. vFileCheck := TTenderFileChecker.Create;
  1572. try
  1573. // 有一期以上数据,且最新期数据审核状态为原报
  1574. bCanImp := vFileCheck.CheckFileValid(sLocalFile) and (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0);
  1575. if not bCanImp then
  1576. begin
  1577. Application.MessageBox(PChar('已从云端下载原报文件到本地,但文件有错误(包含1审数据)禁止接收!请致电纵横服务人员以获取帮助。'),
  1578. '警告', MB_OK + MB_ICONWARNING);
  1579. Exit;
  1580. end;
  1581. finally
  1582. vFileCheck.Free;
  1583. end;
  1584. {注意: 审核末通过的导入更新,这里的MD5码应取最终审核不通过项目的,否则会带来下载循环问题。
  1585. 问题描述:
  1586. ①编制人运行软件,双击项目,发现审核不通过,自动下载无锁文件,开始新一期,保存关闭。
  1587. ②编制人再次运行软件,双击项目,MD5码不同,自动下载旧的审核不通过文件,覆盖本地。
  1588. ③编制人再次运行软件,双击项目,发现审核不通过,重复①,循环....
  1589. 问:①那里下载无锁文件后不能改成新的MD5码吗?
  1590. 答:不能,因为审核人的项目会变成无锁文件,看不到不通过项目。MD5码只能在上传后更新。
  1591. 且编制人有个交互界面2种选择:a.下载更新不通过项目查看;b.下载更新无锁文件开始新一期。}
  1592. end;
  1593. // 接收更新
  1594. if not ReceiveFile(sLocalFile, (AReceiveKind = 2)) then
  1595. begin
  1596. sHint := Format('已从云端下载新的 [%s] 到本地 [%s],但接收失败,请删除该项目然后重新从云端获取!', [FWebBidName_OnLine, sLocalFile]);
  1597. Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
  1598. Exit;
  1599. end;
  1600. if FileExists(sLocalFile) then
  1601. DeleteFile(sLocalFile);
  1602. Result := True;
  1603. end;
  1604. // 为了跟PHP的数组兼容,这里限制数组的第一个元素是A[0](不能是A[1])
  1605. procedure TProjectManagerFrame.OnLineChecker(AAr: TOVArr; var ABegin,
  1606. AEnd: Integer; var AOnLineEndIsOwner: Boolean);
  1607. var i, j: Integer;
  1608. vCS: TCheckStatus;
  1609. begin
  1610. i := 0;
  1611. j := 0;
  1612. ABegin := 0;
  1613. AEnd := 0;
  1614. AOnLineEndIsOwner := AAr[High(AAr), 7] = '1'; // 接口返回的第7列是线上审批标记
  1615. // 数组必须在位置n处截断,后面的部分作废。n的取值情况:
  1616. // ①轮到工作中的那个人的前一个人 ②审核不通过的那个人 ③ 审核通过的人是业主
  1617. if AOnLineEndIsOwner then
  1618. AEnd := High(AAr) + 1
  1619. else
  1620. begin
  1621. for i := High(AAr) downto 0 do
  1622. begin
  1623. vCS := TCheckStatus(StrToInt(AAr[i, 5]) - 1);
  1624. if vCS = csChecking then
  1625. begin
  1626. if (i > 0) and (AAr[i - 1, 7] = '1') then // 前一个人且不是第一个人
  1627. AEnd := i;
  1628. Break;
  1629. end
  1630. else if vCS = csNotPass then
  1631. begin
  1632. if AAr[i, 7] = '1' then
  1633. AEnd := i + 1;
  1634. Break;
  1635. end;
  1636. end;
  1637. end;
  1638. if AEnd = 0 then Exit;
  1639. if AEnd = 1 then
  1640. begin
  1641. ABegin := 1;
  1642. Exit;
  1643. end;
  1644. for j := AEnd -2 downto 0 do
  1645. begin
  1646. if AAr[j, 7] = '0' then
  1647. begin
  1648. ABegin := j + 2;
  1649. Break;
  1650. end
  1651. else
  1652. begin
  1653. if j = 0 then
  1654. ABegin := 1;
  1655. end;
  1656. end;
  1657. end;
  1658. procedure TProjectManagerFrame.actnExportUpdate(Sender: TObject);
  1659. begin
  1660. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected);
  1661. end;
  1662. procedure TProjectManagerFrame.actnOpenBackupFolderUpdate(Sender: TObject);
  1663. begin
  1664. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and
  1665. (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  1666. end;
  1667. procedure TProjectManagerFrame.pnlProgressClick(Sender: TObject);
  1668. var s: string;
  1669. begin
  1670. if (GetKeyState(VK_LSHIFT) < 0) and (GetKeyState(VK_LCONTROL) < 0) then
  1671. begin
  1672. s := Format('%d, %d, %s', [FOnLineCheckerBegin, FOnLineCheckerEnd, BoolToStr(FOnLineCheckerEndIsOwner)]);
  1673. Application.MessageBox(Pchar(s), 'Hint');
  1674. end;
  1675. end;
  1676. procedure TProjectManagerFrame.actnSignOnlineExecute(Sender: TObject);
  1677. var
  1678. iPhase: Integer;
  1679. begin
  1680. LoadSignOnlineSwitch;
  1681. if (FSignOnlineSwitch = 0) then
  1682. WarningMessage('云端未开启在线签署功能。')
  1683. else if SelectOnlineSignPhase(iPhase, stdProjects.IDTree.Selected.Rec) then
  1684. SignOnline(stdProjects.IDTree.Selected, iPhase);
  1685. end;
  1686. procedure TProjectManagerFrame.actnSignOnlineUpdate(Sender: TObject);
  1687. function HasCompletePhase(ARec: TsdDataRecord): Boolean;
  1688. begin
  1689. if (ARec.ValueByName('PhaseCount').AsInteger > 1) then
  1690. Result := True
  1691. else if (ARec.ValueByName('PhaseCount').AsInteger < 1) then
  1692. Result := False
  1693. else
  1694. Result := ARec.ValueByName('AuditStatus').AsInteger = -1;
  1695. end;
  1696. begin
  1697. TAction(Sender).Visible := G_IsCloud and (not IsGuest);
  1698. TAction(Sender).Enabled := (FSignOnlineSwitch = 1) and
  1699. Assigned(stdProjects.IDTree.Selected) and
  1700. (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1) and
  1701. HasCompletePhase(stdProjects.IDTree.Selected.Rec);
  1702. end;
  1703. procedure TProjectManagerFrame.LoadSignOnlineSwitch;
  1704. var
  1705. iResult: Integer;
  1706. sResult: string;
  1707. begin
  1708. FSignOnlineSwitch := 0;
  1709. iResult := PHPWeb.UrlGet(PhPWeb.MeasureURL + 'sign/switch', nil, sResult);
  1710. case iResult of
  1711. 1: FSignOnlineSwitch := StrToIntDef(sResult, 0);
  1712. 0: WarningMessage('网络错误:' + sResult);
  1713. -1: WarningMessage('网络错误:无法连接到云端');
  1714. end;
  1715. end;
  1716. procedure TProjectManagerFrame.actnGuestExecute(Sender: TObject);
  1717. var
  1718. SetGuestForm: TSetGuestForm;
  1719. begin
  1720. CreateProgress('云端取最新审核人列表');
  1721. try
  1722. ShowProjectInfoTopAndCheckers;
  1723. finally
  1724. CloseProgress;
  1725. end;
  1726. SetGuestForm := TSetGuestForm.Create(CurRec.ValueByName('WebID').AsInteger);
  1727. SetGuestForm.Owner := Self;
  1728. try
  1729. SetGuestForm.ShowModal;
  1730. finally
  1731. SetGuestForm.Free;
  1732. end;
  1733. end;
  1734. procedure TProjectManagerFrame.actnGuestUpdate(Sender: TObject);
  1735. begin
  1736. TAction(Sender).Visible := G_IsCloud and (not IsGuest);
  1737. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected) and
  1738. (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  1739. end;
  1740. function TProjectManagerFrame.UserIsChecker(UserID: Integer): Boolean;
  1741. var i: Integer;
  1742. begin
  1743. Result := False;
  1744. if FWebAuthorID = UserID then
  1745. begin
  1746. Result := True;
  1747. Exit;
  1748. end;
  1749. for i := Low(FCheckers) to High(FCheckers) do
  1750. begin
  1751. if StrToInt(FCheckers[i, 0]) = UserID then
  1752. begin
  1753. Result := True;
  1754. Break;
  1755. end;
  1756. end;
  1757. end;
  1758. function TProjectManagerFrame.IsGuest: Boolean;
  1759. begin
  1760. Result := not UserIsChecker(PHPWeb.UserID);
  1761. end;
  1762. end.