ProjectManagerFme.pas 62 KB

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