ProjectManagerFme.pas 51 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679
  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, ExtCtrls,
  9. StdCtrls, sdDB, CslButton, OrderCheckerFme, Contnrs;
  10. type
  11. TProjectManagerFrame = class(TFrame)
  12. ToolBar: TToolBar;
  13. tobtnOpen: TToolButton;
  14. zgProjects: TZJGrid;
  15. tobtnDelete: TToolButton;
  16. ActionList1: TActionList;
  17. actnOpen: TAction;
  18. actnDelete: TAction;
  19. dxpmProjectManager: TdxBarPopupMenu;
  20. actnReceiveProject: TAction;
  21. stdProjects: TsdGridTreeDBA;
  22. actnNewProject: TAction;
  23. actnNewSubProject: TAction;
  24. actnNewTender: TAction;
  25. pnlTenderProperty: TPanel;
  26. sdTenderProperty: TsdGridDBA;
  27. sprProperty: TSplitter;
  28. tobtnRenane: TToolButton;
  29. actnRename: TAction;
  30. tobtnImport: TToolButton;
  31. tobtnExport: TToolButton;
  32. actnImport: TAction;
  33. actnExport: TAction;
  34. tobtn1: TToolButton;
  35. pnlWeb: TPanel;
  36. pnlProject: TPanel;
  37. shp2: TShape;
  38. shp1: TShape;
  39. shp3: TShape;
  40. shp4: TShape;
  41. pnlTenderTitle: TPanel;
  42. lblBidName: TLabel;
  43. pnlShadow: TPanel;
  44. pnlProgress: TPanel;
  45. lblPeriodTotal: TLabel;
  46. lblPeriodState: TLabel;
  47. lblProgress: TLabel;
  48. lblPeriod: TLabel;
  49. pnlBelongProject: TPanel;
  50. lblBelongProject: TLabel;
  51. lblProjName: TLabel;
  52. lblLeftHalfBracket: TLabel;
  53. lblOnwerCompany: TLabel;
  54. lblOnwerName: TLabel;
  55. pnlProjectType: TPanel;
  56. lblProjectType: TLabel;
  57. lblWebProjCtgyName: TLabel;
  58. zgTenderProperty: TZJGrid;
  59. actnOpenBackupFolder: TAction;
  60. sbChecker: TScrollBox;
  61. procedure actnOpenExecute(Sender: TObject);
  62. procedure actnDeleteExecute(Sender: TObject);
  63. procedure zgProjectsMouseDown(Sender: TObject; Button: TMouseButton;
  64. Shift: TShiftState; X, Y: Integer);
  65. procedure actnReceiveProjectExecute(Sender: TObject);
  66. procedure actnNewProjectExecute(Sender: TObject);
  67. procedure actnNewSubProjectExecute(Sender: TObject);
  68. procedure actnNewTenderExecute(Sender: TObject);
  69. procedure zgProjectsDrawCellText(ACanvas: TCanvas; const ARect: TRect;
  70. const ACoord: TPoint; AGrid: TZJGrid; const Text: String;
  71. var ADefaultDraw: Boolean);
  72. procedure actnNewSubProjectUpdate(Sender: TObject);
  73. procedure actnNewTenderUpdate(Sender: TObject);
  74. procedure zgProjectsCurrentChanged(Sender: TObject; Col, Row: Integer);
  75. procedure actnSubmitProjectUpdate(Sender: TObject);
  76. procedure actnReplyProjectUpdate(Sender: TObject);
  77. procedure actnRenameExecute(Sender: TObject);
  78. procedure actnOpenUpdate(Sender: TObject);
  79. procedure actnImportExecute(Sender: TObject);
  80. procedure actnExportExecute(Sender: TObject);
  81. procedure actnDeleteUpdate(Sender: TObject);
  82. procedure actnOpenBackupFolderExecute(Sender: TObject);
  83. procedure actnRenameUpdate(Sender: TObject);
  84. private
  85. FProjectManagerData: TProjectManagerData;
  86. FID: Integer;
  87. FWebID: Integer;
  88. FWebAuthorID: Integer;
  89. FWebOwnerID: Integer;
  90. FWebMD5: string;
  91. FBidName: string;
  92. FWebProjCtgyName: string;
  93. FWebOwnerCompany: string;
  94. FWebProjectName: string;
  95. FWebOwnerRole: string;
  96. FWebOwnerName: string;
  97. FPhaseTotal: Integer;
  98. FPhaseNo: Integer;
  99. FMyCheckStatus: TCheckStatus; // 登陆用户在当前项目中的工作状态。
  100. FProjectCheckStatus: TCheckStatus; // 项目的审核状态。
  101. FCurPos: Integer; // 用来控制审核人的添加位置
  102. FCheckerList: TObjectList;
  103. function ReceiveFile(const AFileName: string; AFileMD5: string = ''; ANeedLock: Boolean = False): Boolean;
  104. function ImportFile(const AFileName: string; AFileMD5: string = ''): Boolean;
  105. procedure ConnectButtonWithAction;
  106. function GetImportProjectName(const AFileName: string; AParent: TsdIDTreeNode): string;
  107. function IsProject(ANode: TsdIDTreeNode): Boolean;
  108. function IsLeafProject(ANode: TsdIDTreeNode): Boolean;
  109. function IsUnEmptyLeafProject(ANode: TsdIDTreeNode): Boolean;
  110. function CheckOpened(ANode: TsdIDTreeNode): Boolean;
  111. procedure SetPropertyVisible(AVisible: Boolean);
  112. procedure SearchAndShowProjAllWebInfo(ARec: TsdDataRecord);
  113. // 网络上的目录结构,本地有则定位,没有则创建。
  114. procedure CheckWebFolders(AFolderID, ASubFolderID: Integer;
  115. AFolderName, ASubFolderName: string);
  116. // ANewBidName: 项目的最新标段名(取自服务器,有人改名了,本地的就变成旧的)
  117. procedure CheckBidName(AID: Integer; ANewBidName: string); overload;
  118. procedure CheckBidName(AUserID, AWebID: Integer; ANewBidName: string); overload;
  119. procedure ClearLocalValues;
  120. procedure GetLocalValues; overload;
  121. procedure GetLocalValues(ARec: TsdDataRecord); overload;
  122. // 用户ID、网络标段ID、Type=1可以定位一个标段。
  123. procedure GetLocalValues(AUserID, AWebID: Integer); overload;
  124. // 1 等待我审核的标段文件; 2 我参与的全部标段文件
  125. procedure DoBatchReceiveOnline(ARequestType: Integer);
  126. function LocalMD5(AUserID, AWebID: Integer): string;
  127. procedure BubbleSortProjects;
  128. public
  129. constructor Create(AOwner: TComponent); override;
  130. destructor Destroy; override;
  131. procedure DoBatchReceiveAllOnline;
  132. // AType: -2 繁忙; -1 正常读取; 0 第0期; 1 第1期。
  133. procedure ShowProjWebInfoTop(AType: Integer = -1);
  134. function Rec(AProjectID: Integer): TsdDataRecord;
  135. function CurRec: TsdDataRecord;
  136. function CurRecAttachmentPath: string;
  137. function AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
  138. property ProjectCheckStatus: TCheckStatus read FProjectCheckStatus;
  139. end;
  140. implementation
  141. uses
  142. MainFrm, UtilMethods, ProjectCommands, Globals, ConfigDoc, ConstUnit,
  143. WebNewTenderFrm, PHPWebDm, Math, CslJson, mProgressFrm, ProgressHintFrm,
  144. ShellAPI;
  145. {$R *.dfm}
  146. procedure TProjectManagerFrame.ConnectButtonWithAction;
  147. begin
  148. SetDxBtnAction(actnNewProject, MainForm.dxbtnNewProject);
  149. SetDxBtnAction(actnNewSubProject, MainForm.dxbtnNewSubProject);
  150. SetDxBtnAction(actnNewTender, MainForm.dxbtnNewTender);
  151. SetDxBtnAction(actnOpen, MainForm.dxbtnOpenProject);
  152. SetDxBtnAction(actnDelete, MainForm.dxbtnDeleteProject);
  153. SetDxBtnAction(actnReceiveProject, MainForm.dxbtnReceiveProject);
  154. SetDxBtnAction(actnOpenBackupFolder, MainForm.dxbtnOpenBackupFolder);
  155. SetDxBtnAction(actnRename, MainForm.dxbtnRename);
  156. end;
  157. constructor TProjectManagerFrame.Create(AOwner: TComponent);
  158. begin
  159. inherited;
  160. FCheckerList := TObjectList.Create;
  161. FProjectManagerData := ProjectManager;
  162. FProjectManagerData.Open;
  163. stdProjects.IDTree := FProjectManagerData.ProjectsTree;
  164. sdTenderProperty.DataView := FProjectManagerData.sdvTenderProperty;
  165. ConnectButtonWithAction;
  166. SetPropertyVisible(False);
  167. sbChecker.Height := 0;
  168. if G_IsCloud then
  169. begin
  170. Application.HintPause := 200;
  171. Application.HintHidePause := 60000;
  172. tobtnImport.Visible := False;
  173. stdProjects.TreeOptions := stdProjects.TreeOptions - [aoAllowUpLevel, aoAllowDownLevel];
  174. stdProjects.Options := stdProjects.Options - [aoAllowUpMove, aoAllowDownMove];
  175. CreateProgress('正在从云端下载新项目');
  176. try
  177. actnReceiveProject.Execute;
  178. finally
  179. CloseProgress;
  180. end;
  181. end;
  182. end;
  183. function SearchFileOnline(AURL: string; var ADownURL, AFolder, ASubFolder, ABidName, AMD5Web, AError: string;
  184. var AFolderID, ASubFolderID: Integer): Integer;
  185. var vArr: TOVArr;
  186. begin
  187. Result := PHPWeb.Search(AURL, [''], [''], vArr);
  188. AError := '';
  189. if Result = 1 then
  190. begin
  191. if High(vArr) >= 0 then
  192. begin
  193. ADownURL := vArr[0, 0];
  194. AFolder := vArr[0, 2];
  195. ASubFolder := vArr[0, 3];
  196. AMD5Web := vArr[0, 1];
  197. AFolderID := StrToInt(vArr[0, 4]);
  198. ASubFolderID := StrToInt(vArr[0, 5]);
  199. ABidName := vArr[0, 6];
  200. end
  201. else
  202. Result := 10; // 返回10,表示无记录。用这个数字代表是否觉得怪异?没办法,0被占用了。
  203. end
  204. else if Result = 0 then
  205. AError := PHPWeb.PageError('标段更新数据失败')
  206. else if Result = -1 then
  207. AError := PHPWeb.NetError('标段更新数据失败');
  208. end;
  209. // 双击打开项目 TagB
  210. procedure TProjectManagerFrame.actnOpenExecute(Sender: TObject);
  211. var
  212. vSel: TsdIDTreeNode;
  213. vRec: TsdDataRecord;
  214. sHint: string;
  215. function CanOpen: Boolean;
  216. var
  217. sSearchURL, sDownURL, sFolder, sSubFolder, sNewName, sMD5,
  218. sMD5_UnLock, sError, sLocalFile: string;
  219. iSearch, iFolderID, iSubFolderID: Integer;
  220. bLock, bCanImp: Boolean;
  221. vFileCheck: TTenderFileChecker;
  222. function HasWebBidInfo(AWebID: Integer): Boolean;
  223. var vArr: array of string;
  224. iResult: Integer;
  225. begin
  226. sSearchURL := Format('%stender/get/%d/exist', [PHPWeb.MeasureURL, AWebID]);
  227. vArr := VarArrayOf(['id', 'name']);
  228. iResult := PHPWeb.Search(sSearchURL, [''], [''], vArr);
  229. if (iResult = 1) and (High(vArr) >= 0) then
  230. Result := True
  231. else
  232. Result := False;
  233. end;
  234. begin
  235. Result := False;
  236. // 先按正常接口找到最新的MD5码看是否需要更新
  237. sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]);
  238. iSearch := SearchFileOnline(sSearchURL, sDownURL, sFolder, sSubFolder, sNewName, sMD5, sError, iFolderID, iSubFolderID);
  239. if iSearch = 1 then
  240. begin
  241. try
  242. CheckWebFolders(iFolderID, iSubFolderID, sFolder, sSubFolder);
  243. CheckBidName(FID, sNewName);
  244. finally
  245. if vSel <> nil then
  246. vSel.LocateInControl;
  247. end;
  248. // 打开前一定要先下载最新的标段文件(无论审核有没有通过)
  249. if sMD5 <> FWebMD5 then
  250. begin
  251. // 下载
  252. sLocalFile := PHPWeb.UserPath + ExtractFileName(sDownURL);
  253. if not PHPWeb.DownFile(sDownURL, sLocalFile) then
  254. begin
  255. sHint := Format('云端已找到"%s"的新文件,但由于网络原因下载失败,请重试!', [FBidName]);
  256. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  257. Exit;
  258. end;
  259. // 接收更新
  260. bLock := (FWebAuthorID = PHPWeb.UserID) or ((FWebAuthorID <> PHPWeb.UserID) and (FMyCheckStatus <> csChecking));
  261. if not ReceiveFile(sLocalFile, sMD5, bLock) then
  262. begin
  263. sHint := Format('已从云端下载新的"%s"到本地[%s],但接收失败,请删除该项目然后重新从云端获取!', [FBidName, sLocalFile]);
  264. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  265. Exit;
  266. end;
  267. end;
  268. // 编制人且项目末通过
  269. if (FWebAuthorID = PHPWeb.UserID) and (FProjectCheckStatus = csNotPass) then
  270. begin
  271. sHint := '本期计量审批不通过,你现在可以:' + #10#13 +
  272. '点击【是(Y)】重新开始本期计量,软件将打开本期上报时的数据,开始重新计量;' + #10#13 +
  273. '点击【否(N)】查看不通过计量,软件将打开本期最后审批的数据,重新打开标段' +
  274. '可再次打开本确认窗口。';
  275. if Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_Yes then
  276. begin
  277. sSearchURL := Format('%suser/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);
  278. case SearchFileOnline(sSearchURL, sDownURL, sFolder, sSubFolder, sNewName, sMD5_UnLock, sError, iFolderID, iSubFolderID) of
  279. 1: {注意这里的MD5码应取最终审核不通过项目的,否则会带来下载循环问题。
  280. 问题描述:
  281. ①编制人运行软件,双击项目,发现审核不通过,自动下载无锁文件,开始新一期,保存关闭。
  282. ②编制人再次运行软件,双击项目,MD5码不同,自动下载旧的审核不通过文件,覆盖本地。
  283. ③编制人再次运行软件,双击项目,发现审核不通过,重复①,循环....
  284. 问:①那里下载无锁文件后不能改成新的MD5码吗?
  285. 答:不能,因为审核人的项目会变成无锁文件,看不到不通过项目。MD5码只能在上传后更新。
  286. 且编制人有个交互界面2种选择:a.下载更新不通过项目查看;b.下载更新无锁文件开始新一期。
  287. }
  288. begin
  289. // 下载
  290. sLocalFile := PHPWeb.UserPath + ExtractFileName(sDownURL);
  291. if not PHPWeb.DownFile(sDownURL, sLocalFile) then
  292. begin
  293. sHint := '云端已找到原报上传的无锁文件,但因网络出错无法下载,本次操作已取消。请重试!';
  294. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  295. Exit;
  296. end;
  297. // 导入更新-------------------------------------------------------
  298. // 导入前须检测无锁文件中仅含有原报数据
  299. vFileCheck := TTenderFileChecker.Create;
  300. try
  301. // 有一期以上数据,且最新期数据审核状态为原报
  302. bCanImp := vFileCheck.CheckFileValid(sLocalFile)
  303. and (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0);
  304. if not bCanImp then
  305. begin
  306. Application.MessageBox(PChar('已从云端下载原报上传的无锁文件到本地,但文件有错误,禁止导入!请致电纵横服务人员以获取帮助。'), '警告', MB_OK + MB_ICONWARNING);
  307. Exit;
  308. end;
  309. finally
  310. vFileCheck.Free;
  311. end;
  312. if not ImportFile(sLocalFile, sMD5) then
  313. begin
  314. Application.MessageBox(PChar('已从云端下载原报上传的无锁文件到本地,但导入失败!请重试。'), '警告', MB_OK + MB_ICONWARNING);
  315. Exit;
  316. end;
  317. // 导入更新---------------------------------↑↑↑↑↑↑↑↑↑↑↑
  318. end;
  319. 0, -1:
  320. begin
  321. sHint := sError + '(因网络出错,无法连接到云端以获取本期原报上传的无锁文件,无法重新开始本期,本次操作已取消。请重试。';
  322. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  323. Exit;
  324. end;
  325. end;
  326. end;
  327. end;
  328. end
  329. <<<<<<< HEAD
  330. else if (iSearch = 10) then
  331. begin
  332. if not HasWebBidInfo(FWebID) then
  333. begin
  334. sHint :='该项目[' + FBidName + ']在云端已被删除,点击"确定"后,可手动删除该项目。';
  335. Application.MessageBox(PChar(sHint), '提示', MB_OK + MB_ICONINFORMATION);
  336. Exit;
  337. end;
  338. end
  339. =======
  340. // else if (iSearch = 10) then
  341. // begin
  342. // sHint :='该项目[' + FBidName + ']在云端已被删除,点击"确定"后,可手动删除该项目。';
  343. // Application.MessageBox(PChar(sHint), '系统提示', MB_OK + MB_ICONINFORMATION);
  344. // Exit;
  345. // end
  346. >>>>>>> 3.1.3.3
  347. else if (iSearch = 0) or (iSearch = -1) then
  348. begin
  349. sHint := sError + '(因网络出错,无法检测[' + FBidName + ']在云端是否有更新,本次操作已取消,请重试)。';
  350. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  351. Exit;
  352. end;
  353. Result := True;
  354. end;
  355. begin
  356. // 打开前先下载更新
  357. Screen.Cursor := crHourGlass;
  358. try
  359. vSel := stdProjects.IDTree.Selected;
  360. vRec := vSel.Rec;
  361. if G_IsCloud then
  362. begin
  363. GetLocalValues;
  364. // 以下这段已经包含在MainForm.OpenProject(vRec)中了,但在调用这句之前,网络版要提前用一下。
  365. if MainForm.HasOpened(FID) then
  366. begin
  367. MainForm.LocateProject(FID);
  368. Exit;
  369. end;
  370. if not CanOpen then
  371. Exit;
  372. end;
  373. MainForm.OpenProject(vRec);
  374. if G_IsCloud then
  375. begin
  376. if not MainForm.CurProjectFrame.CheckFileAndCloudChekerList then
  377. begin
  378. sHint := '项目校验:“' + FBidName + '”文件中的审核人和云端的审核人不一致,' +
  379. '禁止继续操作,项目即将关闭!请删除本地项目重新从云端获取,' +
  380. '重新获取后如果仍然存在同样的问题,请联系纵横服务人员以寻求帮助。';
  381. Application.MessageBox(PChar(sHint), '文件错误', MB_OK +MB_ICONWARNING);
  382. MainForm.actnCloseProject.Execute;
  383. Exit;
  384. end;
  385. end;
  386. finally
  387. Screen.Cursor := crDefault;
  388. end;
  389. end;
  390. procedure TProjectManagerFrame.actnDeleteExecute(Sender: TObject);
  391. begin
  392. if stdProjects.IDTree.Count = 0 then Exit;
  393. with stdProjects.IDTree.Selected.Rec do
  394. if QuestMessage(Format('确定要删除[%s]吗?', [ValueByName('Name').AsString])) then
  395. begin
  396. Screen.Cursor := crHourGlass;
  397. try
  398. FProjectManagerData.Delete;
  399. finally
  400. Screen.Cursor := crDefault;
  401. end;
  402. end;
  403. end;
  404. procedure TProjectManagerFrame.zgProjectsMouseDown(Sender: TObject;
  405. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  406. begin
  407. if Button = mbRight then
  408. dxpmProjectManager.PopupFromCursorPos
  409. else if (zgProjects.CurCol = 1) and (Button = mbLeft) and (ssDouble in Shift)
  410. and Assigned(stdProjects.IDTree.Selected) then
  411. begin
  412. if IsProject(stdProjects.IDTree.Selected) then
  413. stdProjects.IDTree.Selected.Expand
  414. else
  415. actnOpen.Execute;
  416. end;
  417. end;
  418. function TProjectManagerFrame.ReceiveFile(const AFileName: string; AFileMD5: string;
  419. ANeedLock: Boolean): Boolean;
  420. var
  421. Recevier: TReceiveProject;
  422. vNode: TsdIDTreeNode;
  423. begin
  424. Result := False;
  425. Recevier := TReceiveProject.Create(stdProjects.IDTree.Selected);
  426. try
  427. try
  428. if G_IsCloud then
  429. Recevier.Lock := ANeedLock;
  430. ProjectManager.RefreshSeedID;
  431. vNode := Recevier.Receive(AFileName);
  432. if G_IsCloud then
  433. begin
  434. vNode.Rec.BeginUpdate;
  435. vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5;
  436. vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
  437. vNode.Rec.EndUpdate;
  438. end;
  439. vNode.LocateInControl;
  440. Result := True;
  441. except
  442. Result := False;
  443. end;
  444. finally
  445. if Recevier.MessageID = 1 then
  446. ErrorMessage('当前标段处于打开状态,未能成功接收,请先关闭标段再次接收。');
  447. Recevier.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. FWebProjectName := vArr[6];
  577. FWebProjCtgyName := vArr[7];
  578. // WebOwnerImage := vArr[9];
  579. // WebOwnerPhone := vArr[3];
  580. // WebOwnerMobile := vArr[4];
  581. // WebOwnerQQ := vArr[5];
  582. ShowProjWebInfoTop(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);
  607. begin
  608. with stdProjects.IDTree.Items[ACoord.Y - 1] do
  609. if Rec.ValueByName('Type').AsInteger = 0 then
  610. if Expanded and HasChildren then
  611. MainForm.Images.GetBitmap(34, AImage)
  612. else
  613. MainForm.Images.GetBitmap(34, AImage)
  614. else
  615. MainForm.Images.GetBitmap(11, AImage);
  616. end;
  617. const
  618. rIconWidth = 16;
  619. rIconHeight = 16;
  620. var
  621. Img: TBitmap;
  622. Cell: TZjCell;
  623. rImg: TRect;
  624. begin
  625. if (ACoord.X = 1) and (ACoord.Y > zgProjects.FixedRowCount - 1) then
  626. begin
  627. Cell := zgProjects.Cells[ACoord.X, ACoord.Y];
  628. Img := TBitmap.Create;
  629. try
  630. GetBitmap(Img);
  631. case Cell.Align of
  632. gaTopLeft, gaTopCenter, gaTopRight:
  633. rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);
  634. gaCenterLeft, gaCenterCenter, gaCenterRight:
  635. 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);
  636. gaBottomLeft, gaBottomCenter, gaBottomRight:
  637. rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);
  638. end;
  639. ACanvas.StretchDraw(rImg, Img);
  640. WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)
  641. , 2, 2, Text, Cell.Align, False);
  642. ADefaultDraw := False;
  643. finally
  644. Img.Free;
  645. end;
  646. end;
  647. end;
  648. procedure TProjectManagerFrame.actnNewSubProjectUpdate(Sender: TObject);
  649. begin
  650. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  651. and IsProject(stdProjects.IDTree.Selected)
  652. and (not IsUnEmptyLeafProject(stdProjects.IDTree.Selected));
  653. end;
  654. procedure TProjectManagerFrame.actnNewTenderUpdate(Sender: TObject);
  655. var bCloud: Boolean;
  656. vNode: TsdIDTreeNode;
  657. begin
  658. bCloud := G_IsCloud;
  659. // 只有编制人才能创建新标段?逻辑先后有问题:编制人是在创建标段之后产生的。
  660. // 创建前,当前用户只是一个帐户,它是不是编制人末知,因为它还可以是其它角色。
  661. // 同一帐户在不同的标段可以作为不同的角色。
  662. if bCloud then
  663. begin
  664. TAction(Sender).Enabled := True;
  665. end
  666. else
  667. begin
  668. vNode := stdProjects.IDTree.Selected;
  669. TAction(Sender).Enabled := Assigned(vNode) and IsProject(vNode) and IsLeafProject(vNode);
  670. end;
  671. end;
  672. function TProjectManagerFrame.IsLeafProject(ANode: TsdIDTreeNode): Boolean;
  673. begin
  674. if ANode.HasChildren then
  675. Result := ANode.FirstChild.Rec.ValueByName('Type').AsInteger = 1
  676. else
  677. Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
  678. end;
  679. function TProjectManagerFrame.IsProject(ANode: TsdIDTreeNode): Boolean;
  680. begin
  681. Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
  682. end;
  683. function TProjectManagerFrame.IsUnEmptyLeafProject(
  684. ANode: TsdIDTreeNode): Boolean;
  685. begin
  686. Result := ANode.HasChildren and (ANode.Rec.ValueByName('Type').AsInteger = 1);
  687. end;
  688. procedure TProjectManagerFrame.SetPropertyVisible(AVisible: Boolean);
  689. begin
  690. // 单击刷新项目信息 TagA
  691. if G_IsCloud then
  692. begin
  693. if CurRec = nil then Exit;
  694. pnlTenderProperty.Visible := False;
  695. pnlWeb.Visible := AVisible;
  696. if AVisible then
  697. begin
  698. CreateProgress('云端读取项目信息');
  699. try
  700. SearchAndShowProjAllWebInfo(CurRec);
  701. finally
  702. CloseProgress;
  703. end;
  704. end;
  705. end
  706. else
  707. begin
  708. pnlWeb.Visible := False;
  709. pnlTenderProperty.Visible := AVisible;
  710. sprProperty.Visible := AVisible;
  711. end;
  712. end;
  713. procedure TProjectManagerFrame.zgProjectsCurrentChanged(Sender: TObject;
  714. Col, Row: Integer);
  715. begin
  716. if G_IsCloud then
  717. begin
  718. if CurRec <> nil then
  719. begin
  720. // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
  721. // if FID <> CurRec.ValueByName('ID').AsInteger then
  722. SetPropertyVisible(CurRec.ValueByName('Type').AsInteger = 1);
  723. // OnCurrentChanged取得的 CurRec.ValueByName() 值并不总是可靠,这里加保险。
  724. // 如调用locateInControl后,执行到这里取得的CurRec.ValueByName('ID')值还是上一条的。
  725. if (CurRec.ValueByName('Type').AsInteger = 1) and (not pnlWeb.Visible) then
  726. pnlWeb.Visible := True;
  727. end;
  728. end;
  729. end;
  730. procedure TProjectManagerFrame.actnSubmitProjectUpdate(Sender: TObject);
  731. begin
  732. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  733. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1)
  734. and (stdProjects.IDTree.Selected.Rec.ValueByName('AuditStatus').AsInteger < iMaxStageCount-1);
  735. end;
  736. procedure TProjectManagerFrame.actnReplyProjectUpdate(Sender: TObject);
  737. begin
  738. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  739. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  740. end;
  741. procedure TProjectManagerFrame.actnRenameExecute(Sender: TObject);
  742. function CanRename(ARec: TsdDataRecord; const ANewName: string): Boolean;
  743. var
  744. sURL: string;
  745. iRename: Integer;
  746. vArr: array of string;
  747. begin
  748. Result := True;
  749. if not G_IsCloud then Exit;
  750. // 云版 重命名须确保同步服务器
  751. sURL := Format('%stender/%d/%s/update', [PHPWeb.MeasureURL, ARec.ValueByName('WebID').AsInteger, ANewName]);
  752. iRename := PHPWeb.Search(sURL, [], [], vArr);
  753. Result := iRename = 1;
  754. case iRename of
  755. 1: ShowMessage('新的标段名称已同步到服务器!');
  756. 0: Application.MessageBox(PChar(PHPWeb.PageError('重命名同步到云端失败' + '[' + vArr[0] + ']')),
  757. '警告', MB_OK + MB_ICONWARNING);
  758. -1: Application.MessageBox(PChar(PHPWeb.NetError('重命名同步到云端失败')),
  759. '警告', MB_OK + MB_ICONWARNING);
  760. end;
  761. end;
  762. var
  763. stnNode: TsdIDTreeNode;
  764. sName: string;
  765. begin
  766. stnNode := stdProjects.IDTree.Selected;
  767. sName := stnNode.Rec.ValueByName('Name').AsString;
  768. if not Assigned(OpenProjectManager.FindProjectData(stnNode.ID)) then
  769. begin
  770. if InputNewProjectName(sName, '重命名', stnNode.Parent, stnNode.ID) then
  771. begin
  772. if CanRename(stnNode.Rec, sName) then
  773. begin
  774. stnNode.Rec.ValueByName('Name').AsString := sName;
  775. ProjectManager.Save;
  776. end;
  777. end;
  778. end
  779. else
  780. ErrorMessage(Format('项目[%s]已经打开,无法重命名!', [sName]));
  781. end;
  782. procedure TProjectManagerFrame.actnOpenUpdate(Sender: TObject);
  783. begin
  784. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  785. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  786. end;
  787. procedure TProjectManagerFrame.actnImportExecute(Sender: TObject);
  788. procedure ImportTender(const AFileName, AProjectName: string);
  789. var
  790. Importor: TTenderImport;
  791. begin
  792. Importor := TTenderImport.Create(stdProjects.IDTree.Selected,
  793. AProjectName, AFileName);
  794. try
  795. Importor.Execute;
  796. finally
  797. Importor.Free;
  798. end;
  799. end;
  800. procedure ImportProject(const AFileName, AProjectName: string);
  801. var
  802. Importor: TProjectImport;
  803. begin
  804. Importor := TProjectImport.Create(stdProjects.IDTree.Selected,
  805. AProjectName, AFileName);
  806. try
  807. Importor.Execute;
  808. finally
  809. Importor.Free;
  810. end;
  811. end;
  812. var
  813. sFileName, sProjectName: string;
  814. begin
  815. if SelectFile(sFileName, '.mtf;*.mpf') then
  816. begin
  817. if SameText(ExtractFileExt(sFileName), '.mtf')
  818. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 0) then
  819. sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected)
  820. else
  821. sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected.Parent);
  822. Screen.Cursor := crHourGlass;
  823. try
  824. if SameText(ExtractFileExt(sFileName), '.mtf') then
  825. ImportTender(sFileName, sProjectName)
  826. else
  827. ImportProject(sFileName, sProjectName);
  828. finally
  829. Screen.Cursor := crDefault;
  830. end;
  831. end;
  832. FProjectManagerData.Save;
  833. end;
  834. procedure TProjectManagerFrame.actnExportExecute(Sender: TObject);
  835. procedure ExportTender(ANode: TsdIDTreeNode);
  836. var
  837. Exportor: TTenderExport;
  838. sFileName, sHint: string;
  839. bExpAtch: Boolean;
  840. iCount: Integer;
  841. begin
  842. bExpAtch := False;
  843. sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mtf';
  844. if SaveFile(sFileName, '.mtf') then
  845. begin
  846. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  847. Exit;
  848. Screen.Cursor := crHourGlass;
  849. try
  850. Exportor := TTenderExport.Create(ANode.Rec, sFileName);
  851. try
  852. { if not G_IsCloud then
  853. begin
  854. iCount := FileCount(CurRecAttachmentPath);
  855. if iCount > 1 then // 排除管理文件库
  856. begin
  857. sHint := Format('本标段包含 %d 个附件,是否将附件一起导出?', [iCount - 1]);
  858. bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
  859. end;
  860. end; } // FFFFF
  861. Exportor.Execute(bExpAtch);
  862. finally
  863. Exportor.Free;
  864. end;
  865. finally
  866. Screen.Cursor := crDefault;
  867. end;
  868. end;
  869. end;
  870. procedure ExportProject(ANode: TsdIDTreeNode);
  871. var
  872. Exportor: TProjectExport;
  873. sFileName, sHint: string;
  874. bExpAtch: Boolean;
  875. iCount: Integer;
  876. begin
  877. sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mpf';
  878. if SaveFile(sFileName, '.mpf') then
  879. begin
  880. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  881. Exit;
  882. Screen.Cursor := crHourGlass;
  883. try
  884. bExpAtch := False;
  885. { if not G_IsCloud then
  886. begin
  887. iCount := AttachmentFileCountsWithoutManageFile(ANode);
  888. if iCount > 0 then
  889. begin
  890. sHint := Format('本建设项目共包含 %d 个附件,是否将附件一起导出?', [iCount]);
  891. bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
  892. end;
  893. end; } // FFFFF
  894. Exportor := TProjectExport.Create(ANode, sFileName, bExpAtch);
  895. try
  896. Exportor.Execute;
  897. finally
  898. Exportor.Free;
  899. end;
  900. finally
  901. Screen.Cursor := crDefault;
  902. end;
  903. end;
  904. end;
  905. var
  906. stnNode: TsdIDTreeNode;
  907. begin
  908. stnNode := stdProjects.IDTree.Selected;
  909. if stnNode.Rec.ValueByName('Type').AsInteger = 1 then
  910. begin
  911. ExportTender(stnNode);
  912. end
  913. else
  914. ExportProject(stnNode);
  915. end;
  916. procedure TProjectManagerFrame.actnDeleteUpdate(Sender: TObject);
  917. begin
  918. if Assigned(stdProjects.IDTree.Selected) then
  919. TAction(Sender).Enabled := not CheckOpened(stdProjects.IDTree.Selected);
  920. end;
  921. function TProjectManagerFrame.CheckOpened(ANode: TsdIDTreeNode): Boolean;
  922. var
  923. iChild: Integer;
  924. begin
  925. Result := False;
  926. if ANode.Rec.ValueByName('Type').AsInteger = 1 then
  927. Result := OpenProjectManager.ProjectIndex(ANode.ID) > -1
  928. else
  929. begin
  930. if not ANode.HasChildren then
  931. Result := False
  932. else
  933. begin
  934. for iChild := 0 to ANode.ChildCount - 1 do
  935. Result := Result or CheckOpened(ANode.ChildNodes[iChild]);
  936. end
  937. end;
  938. end;
  939. procedure TProjectManagerFrame.SearchAndShowProjAllWebInfo(ARec: TsdDataRecord);
  940. var
  941. vPSArr: array[0..7] of string;
  942. vCArr: TOVArr; // Checkers
  943. vChecker: TOrderCheckerFrame;
  944. sPicPath, sURL: string;
  945. procedure AddChecker(AType: TCheckerFrameType; AArr: array of string);
  946. begin
  947. vChecker := TOrderCheckerFrame.Create(self);
  948. FCheckerList.Add(vChecker);
  949. vChecker.Owner := Self;
  950. sbChecker.VertScrollBar.Range := sbChecker.VertScrollBar.Range + vChecker.Height;
  951. sbChecker.Height := Min(sbChecker.Height + vChecker.Height, pnlWeb.Height - pnlProject.Height);
  952. vChecker.Parent := sbChecker;
  953. vChecker.Top := FCurPos;
  954. FCurPos := FCurPos + vChecker.Height;
  955. vChecker.Align := alTop;
  956. sPicPath := PHPWeb.UserPath + '1_' + AArr[0] + '.jpg';
  957. PHPWeb.DownFile(AArr[4], sPicPath);
  958. vChecker.Init(AType, StrToInt(AArr[0]), AArr[1], AArr[3],
  959. AArr[2], sPicPath, AArr[6], TCheckStatus(StrToInt(AArr[5])-1));
  960. vChecker.Name := 'ProjectOrderFrame' + AArr[0];
  961. end;
  962. procedure RepairOrder;
  963. var k: Integer;
  964. begin
  965. for k := 0 to sbChecker.ControlCount - 1 do
  966. TOrderCheckerFrame(sbChecker.Controls[k]).Order := k + 1;
  967. end;
  968. procedure RefreshProjectCheckers;
  969. var i, j: Integer;
  970. vOwner: array[0..6] of string; // 业主信息
  971. begin
  972. FCheckerList.Clear;
  973. sbChecker.Height := 0;
  974. FCurPos := 0;
  975. sbChecker.VertScrollBar.Range := 0;
  976. for i := Low(vCArr) to High(vCArr) do
  977. begin
  978. if StrToInt(vCArr[i, 0]) = PHPWeb.UserID then
  979. FMyCheckStatus := TCheckStatus(StrToInt(vCArr[i, 5])-1);
  980. if StrToInt(vCArr[i, 0]) = FWebOwnerID then
  981. begin
  982. for j := 0 to 6 do
  983. vOwner[j] := vCArr[i, j];
  984. Continue;
  985. end;
  986. AddChecker(cftChecker, vCArr[i]);
  987. end;
  988. if vOwner[0] <> '' then
  989. AddChecker(cftOwner, vOwner);
  990. RepairOrder;
  991. end;
  992. begin
  993. GetLocalValues(ARec);
  994. if FWebID = 0 then Exit;
  995. sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
  996. if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then
  997. begin
  998. LockWindowUpdate(pnlWeb.Handle);
  999. try
  1000. FPhaseNo := StrToInt(vPSArr[0]);
  1001. FProjectCheckStatus := TCheckStatus(StrToInt(vPSArr[1])-1);
  1002. FPhaseTotal := StrToInt(vPSArr[2]);
  1003. FWebProjectName := vPSArr[3];
  1004. FWebProjCtgyName := vPSArr[4];
  1005. FWebOwnerName := vPSArr[5];
  1006. FWebOwnerCompany := vPSArr[6];
  1007. FWebOwnerRole := vPSArr[7];
  1008. ShowProjWebInfoTop;
  1009. RefreshProjectCheckers;
  1010. finally
  1011. LockWindowUpdate(0);
  1012. end;
  1013. end
  1014. else
  1015. begin
  1016. FPhaseNo := 0;
  1017. FProjectCheckStatus := csNotBegin;
  1018. FPhaseTotal := 0;
  1019. FWebProjectName := '';
  1020. FWebProjCtgyName := '';
  1021. FWebOwnerName := '';
  1022. FWebOwnerCompany := '';
  1023. FWebOwnerRole := '';
  1024. ShowProjWebInfoTop;
  1025. sbChecker.Height := 0;
  1026. end;
  1027. end;
  1028. procedure TProjectManagerFrame.ShowProjWebInfoTop(AType: Integer);
  1029. procedure ShowOwner;
  1030. begin
  1031. lblBidName.Caption := FBidName;
  1032. lblBidName.Update;
  1033. lblProjName.Caption := FWebProjectName;
  1034. lblProjName.Update;
  1035. lblWebProjCtgyName.Caption := FWebProjCtgyName;
  1036. lblWebProjCtgyName.Update;
  1037. lblOnwerName.Caption := FWebOwnerName;
  1038. lblOnwerName.Update;
  1039. lblOnwerCompany.Caption := Format('-%s)', [FWebOwnerCompany]);
  1040. lblOnwerCompany.Update;
  1041. lblOnwerCompany.Left := lblOnwerName.Left + lblOnwerName.Width;
  1042. end;
  1043. procedure ShowStatus(ANo: Integer; AState: TCheckStatus);
  1044. begin
  1045. lblPeriod.Caption := Format('第%d期', [ANo]);
  1046. lblPeriod.Update;
  1047. lblPeriodState.Caption := CheckStatusNames[AState];
  1048. lblPeriodState.Font.Color := CheckStatusColors[AState];
  1049. lblPeriodState.Update;
  1050. lblPeriodState.Left := lblPeriod.Left + lblPeriod.Width + 5;
  1051. lblPeriodTotal.Caption := Format('(共%d期)', [ANo]);
  1052. lblPeriodTotal.Update;
  1053. lblPeriodTotal.Left := lblPeriodState.Left + lblPeriodState.Width + 3;
  1054. end;
  1055. begin
  1056. GetLocalValues;
  1057. case AType of
  1058. -2:
  1059. begin
  1060. lblPeriod.Caption := '正在从云端读取状态信息...';
  1061. lblPeriod.Update;
  1062. end;
  1063. -1:
  1064. begin
  1065. ShowOwner;
  1066. ShowStatus(FPhaseNo, FProjectCheckStatus);
  1067. end;
  1068. 0:
  1069. begin
  1070. ShowOwner;
  1071. ShowStatus(0, csNotBegin);
  1072. end;
  1073. end;
  1074. end;
  1075. // 检查后,应该定位到最后一层目录,不应该回到原先的选择节点。否则从网络拉下来的项目无法组织正确的树结构。
  1076. procedure TProjectManagerFrame.CheckWebFolders(AFolderID, ASubFolderID: Integer;
  1077. AFolderName, ASubFolderName: string);
  1078. var
  1079. vTree: TsdIDTree;
  1080. vNode, vSubNode: TsdIDTreeNode;
  1081. i: Integer;
  1082. sName: string;
  1083. iUserID, iWebID, iWebFolderLevel: Integer;
  1084. bExist, bSubExist, bModified: Boolean;
  1085. begin
  1086. bExist := False;
  1087. bSubExist := False;
  1088. bModified := False;
  1089. vTree := stdProjects.IDTree;
  1090. for i := 0 to vTree.Count - 1 do
  1091. begin
  1092. vNode := vTree.Items[i];
  1093. sName := vNode.Rec.ValueByName('Name').AsString;
  1094. iUserID := vNode.Rec.ValueByName('WebUserID').AsInteger;
  1095. iWebID := vNode.Rec.ValueByName('WebID').AsInteger;
  1096. iWebFolderLevel := vNode.Rec.ValueByName('WebFolderLevel').AsInteger;
  1097. if (iWebID = AFolderID) and (iWebFolderLevel = G_WFL_ProjName) and (iUserID = PHPWeb.UserID) then
  1098. begin
  1099. bExist := True;
  1100. vNode.LocateInControl;
  1101. if not SameText(sName, AFolderName) then
  1102. begin
  1103. vNode.Rec.ValueByName('Name').AsString := AFolderName;
  1104. bModified := True;
  1105. end;
  1106. Break;
  1107. end;
  1108. end;
  1109. if not bExist then
  1110. begin
  1111. vNode := vTree.Items[0];
  1112. if Assigned(vNode) then
  1113. vNode.LocateInControl;
  1114. vNode := FProjectManagerData.InsertProject(AFolderName, stdProjects.IDTree.Selected, AFolderID, G_WFL_ProjName);
  1115. vNode.LocateInControl;
  1116. end;
  1117. for i := 0 to vNode.ChildCount - 1 do
  1118. begin
  1119. vSubNode := vNode.ChildNodes[i];
  1120. sName := vSubNode.Rec.ValueByName('Name').AsString;
  1121. iUserID := vSubNode.Rec.ValueByName('WebUserID').AsInteger;
  1122. iWebID := vSubNode.Rec.ValueByName('WebID').AsInteger;
  1123. iWebFolderLevel := vSubNode.Rec.ValueByName('WebFolderLevel').AsInteger;
  1124. if (iWebID = ASubFolderID) and (iWebFolderLevel = G_WFL_BidType) and (iUserID = PHPWeb.UserID) then
  1125. begin
  1126. bSubExist := True;
  1127. vSubNode.LocateInControl;
  1128. if not SameText(sName, ASubFolderName) then
  1129. begin
  1130. vSubNode.Rec.ValueByName('Name').AsString := ASubFolderName;
  1131. bModified := True;
  1132. end;
  1133. Break;
  1134. end;
  1135. end;
  1136. if not bSubExist then
  1137. begin
  1138. vNode.LocateInControl;
  1139. vNode := FProjectManagerData.InsertSubProject(ASubFolderName, stdProjects.IDTree.Selected, ASubFolderID, G_WFL_BidType);
  1140. vNode.LocateInControl;
  1141. end;
  1142. if bModified then
  1143. ProjectManager.Save;
  1144. end;
  1145. function TProjectManagerFrame.Rec(AProjectID: Integer): TsdDataRecord;
  1146. var i: Integer;
  1147. vTree: TsdIDTree;
  1148. begin
  1149. vTree := stdProjects.IDTree;
  1150. if vTree.Selected.Rec.ValueByName('ID').AsInteger = AProjectID then
  1151. begin
  1152. Result := stdProjects.IDTree.Selected.Rec;
  1153. Exit;
  1154. end;
  1155. for i := 0 to vTree.Count - 1 do
  1156. begin
  1157. if vTree.Items[i].Rec.ValueByName('ID').AsInteger = AProjectID then
  1158. begin
  1159. Result := vTree.Items[i].Rec;
  1160. vTree.Items[i].LocateInControl;
  1161. Break;
  1162. end;
  1163. end;
  1164. end;
  1165. destructor TProjectManagerFrame.Destroy;
  1166. begin
  1167. FCheckerList.Free;
  1168. inherited;
  1169. end;
  1170. procedure TProjectManagerFrame.DoBatchReceiveOnline(ARequestType: Integer);
  1171. var
  1172. sURL, sFolder, sSubFolder, sMD5, sName, sHint, sLocalFile: string;
  1173. vMyCheckStatus: TCheckStatus;
  1174. vArr: TOVArr;
  1175. bLock: Boolean;
  1176. i, iWebID, iFolderID, iSubFolderID, iAuthorID: Integer;
  1177. begin
  1178. // 查询等待我审核的标段文件,杰哥说分三种:①业主未审核 ②业主审核中 ③审核人审核中 (为什么加①?问杰哥)
  1179. case PHPWeb.Search(PHPWeb.MeasureURL + 'user/get/audit/project', ['audituid', 'RequestType'],
  1180. [IntToStr(PHPWeb.UserID), IntToStr(ARequestType)], vArr) of
  1181. 1:
  1182. begin
  1183. CreateProgress('正在从云端下载新项目');
  1184. try
  1185. for i := Low(vArr) to High(vArr) do
  1186. begin
  1187. sURL := vArr[i, 0];
  1188. sFolder := vArr[i, 1];
  1189. sSubFolder := vArr[i, 2];
  1190. sMD5 := vArr[i, 3];
  1191. iWebID := StrToInt(vArr[i, 5]);
  1192. iFolderID := StrToInt(vArr[i, 6]);
  1193. iSubFolderID := StrToInt(vArr[i, 7]);
  1194. vMyCheckStatus := TCheckStatus(StrToInt(vArr[i, 8])-1); // vArr[i, 4]项目审核状态;vArr[i, 8]当前登陆用户的审核状态
  1195. iAuthorID := StrToInt(vArr[i, 9]); // 编制人ID
  1196. sName := vArr[i, 10]; // 标段名称
  1197. CheckWebFolders(iFolderID, iSubFolderID, sFolder, sSubFolder);
  1198. CheckBidName(PHPWeb.UserID, iWebID, sName);
  1199. if sMD5 <> LocalMD5(PHPWeb.UserID, iWebID) then
  1200. begin
  1201. // 下载
  1202. sLocalFile := PHPWeb.UserPath + ExtractFileName(sURL);
  1203. if not PHPWeb.DownFile(sURL, sLocalFile) then
  1204. begin
  1205. sHint := Format('云端已找到"%s"的新文件,但由于网络原因下载失败!请点击菜单“同步更新我参与的全部项目”重新下载!', [sName]);
  1206. Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
  1207. end;
  1208. // 接收更新
  1209. bLock := (iAuthorID = PHPWeb.UserID) or ((iAuthorID <> PHPWeb.UserID) and (vMyCheckStatus <> csChecking));
  1210. if not ReceiveFile(sLocalFile, sMD5, bLock) then
  1211. begin
  1212. sHint := Format('已从云端下载新的"%s"到本地,但接收失败,请删除该项目然后重新从云端获取!', [sName]);
  1213. Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
  1214. Exit;
  1215. end;
  1216. end;
  1217. end;
  1218. BubbleSortProjects;
  1219. finally
  1220. CloseProgress;
  1221. end;
  1222. end;
  1223. 0, -1:
  1224. begin
  1225. sHint := '网络出错,无法查询云端项目的更新情况,请重试!';
  1226. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  1227. Exit;
  1228. end;
  1229. end;
  1230. end;
  1231. function TProjectManagerFrame.ImportFile(const AFileName: string; AFileMD5: string): Boolean;
  1232. var
  1233. vImport: TTenderImport;
  1234. vNode: TsdIDTreeNode;
  1235. begin
  1236. Result := False;
  1237. vNode := stdProjects.IDTree.Selected;
  1238. vImport := TTenderImport.Create(vNode, '', AFileName);
  1239. try
  1240. try
  1241. vImport.ImportToSelect;
  1242. vNode.LocateInControl;
  1243. Result := True;
  1244. except
  1245. Result := False;
  1246. end;
  1247. finally
  1248. vImport.Free;
  1249. vNode.Rec.BeginUpdate;
  1250. vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5;
  1251. vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
  1252. vNode.Rec.EndUpdate;
  1253. FProjectManagerData.Save;
  1254. end;
  1255. end;
  1256. procedure TProjectManagerFrame.actnOpenBackupFolderExecute(
  1257. Sender: TObject);
  1258. var
  1259. stnNode: TsdIDTreeNode;
  1260. begin
  1261. stnNode := stdProjects.IDTree.Selected;
  1262. if stnNode.Rec.ValueByName('BackupFolder').AsString = '' then
  1263. TipMessage('该项目暂无备份数据!')
  1264. else
  1265. ShellExecute(Handle, 'open', 'Explorer.exe',
  1266. PChar(FProjectManagerData.BackupPath(stnNode.ID)), nil, 1);
  1267. end;
  1268. procedure TProjectManagerFrame.actnRenameUpdate(Sender: TObject);
  1269. var
  1270. Rec: TsdDataRecord;
  1271. bNet: Boolean;
  1272. begin
  1273. if stdProjects.IDTree.Selected = nil then Exit;
  1274. Rec := stdProjects.IDTree.Selected.Rec;
  1275. if Rec = nil then Exit;
  1276. bNet := G_IsCloud;
  1277. if bNet then
  1278. begin
  1279. tobtnRenane.Enabled := (Rec.ValueByName('Type').AsInteger = 1) and
  1280. (Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID);
  1281. end;
  1282. end;
  1283. procedure TProjectManagerFrame.CheckBidName(AID: Integer; ANewBidName: string);
  1284. var vNode: TsdIDTreeNode;
  1285. begin
  1286. vNode := stdProjects.IDTree.FindNode(AID);
  1287. if vNode = nil then Exit;
  1288. if vNode.Rec.ValueByName('Name').AsString <> ANewBidName then
  1289. begin
  1290. vNode.Rec.ValueByName('Name').AsString := ANewBidName;
  1291. ProjectManager.Save;
  1292. end;
  1293. end;
  1294. procedure TProjectManagerFrame.DoBatchReceiveAllOnline;
  1295. var
  1296. OnCC: TZjCellNotifyEvent;
  1297. begin
  1298. OnCC := zgProjects.OnCurrentChanged;
  1299. try
  1300. zgProjects.OnCurrentChanged := nil;
  1301. DoBatchReceiveOnline(2);
  1302. if stdProjects.IDTree.FirstNode <> nil then
  1303. stdProjects.IDTree.FirstNode.LocateInControl;
  1304. finally
  1305. zgProjects.OnCurrentChanged := OnCC;
  1306. end;
  1307. end;
  1308. procedure TProjectManagerFrame.GetLocalValues;
  1309. begin
  1310. GetLocalValues(CurRec);
  1311. end;
  1312. procedure TProjectManagerFrame.GetLocalValues(ARec: TsdDataRecord);
  1313. begin
  1314. if not Assigned(ARec) then
  1315. begin
  1316. ClearLocalValues;
  1317. Exit;
  1318. end;
  1319. // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
  1320. // if ARec.ValueByName('ID').AsInteger <> FID then
  1321. begin
  1322. FID := ARec.ValueByName('ID').AsInteger;
  1323. FWebID := ARec.ValueByName('WebID').AsInteger;
  1324. FWebAuthorID := ARec.ValueByName('WebAuthorID').AsInteger;
  1325. FWebOwnerID := ARec.ValueByName('WebOwnerID').AsInteger;
  1326. FWebMD5 := ARec.ValueByName('WebMD5').AsString;
  1327. FBidName := ARec.ValueByName('Name').AsString;
  1328. end;
  1329. end;
  1330. procedure TProjectManagerFrame.GetLocalValues(AUserID, AWebID: Integer);
  1331. var i: Integer;
  1332. vTree: TsdIDTree;
  1333. vRec: TsdDataRecord;
  1334. begin
  1335. ClearLocalValues; // 先清空,以防没找到。
  1336. if (CurRec <> nil) and
  1337. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1338. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1339. (CurRec.ValueByName('Type').AsInteger = 1) then
  1340. begin
  1341. GetLocalValues(vRec);
  1342. Exit;
  1343. end;
  1344. vTree := stdProjects.IDTree;
  1345. for i := 0 to vTree.Count - 1 do
  1346. begin
  1347. vRec := vTree.Items[i].Rec;
  1348. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1349. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1350. (vRec.ValueByName('Type').AsInteger = 1) then
  1351. begin
  1352. GetLocalValues(vRec);
  1353. Break;
  1354. end;
  1355. end;
  1356. end;
  1357. procedure TProjectManagerFrame.ClearLocalValues;
  1358. begin
  1359. FID := -1;
  1360. FWebID := -1;
  1361. FWebAuthorID := -1;
  1362. FWebOwnerID := -1;
  1363. FWebMD5 := '';
  1364. FBidName := '';
  1365. end;
  1366. function TProjectManagerFrame.LocalMD5(AUserID, AWebID: Integer): string;
  1367. var i: Integer;
  1368. vTree: TsdIDTree;
  1369. vRec: TsdDataRecord;
  1370. begin
  1371. Result := '本地无MD5码';
  1372. if (CurRec <> nil) and
  1373. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1374. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1375. (CurRec.ValueByName('Type').AsInteger = 1) then
  1376. begin
  1377. Result := vRec.ValueByName('WebMD5').AsString;
  1378. Exit;
  1379. end;
  1380. vTree := stdProjects.IDTree;
  1381. for i := 0 to vTree.Count - 1 do
  1382. begin
  1383. vRec := vTree.Items[i].Rec;
  1384. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1385. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1386. (vRec.ValueByName('Type').AsInteger = 1) then
  1387. begin
  1388. Result := vRec.ValueByName('WebMD5').AsString;
  1389. Break;
  1390. end;
  1391. end;
  1392. end;
  1393. function TProjectManagerFrame.CurRec: TsdDataRecord;
  1394. begin
  1395. if stdProjects.IDTree.Selected = nil then
  1396. Result := nil
  1397. else
  1398. Result := stdProjects.IDTree.Selected.Rec;
  1399. end;
  1400. procedure TProjectManagerFrame.CheckBidName(AUserID, AWebID: Integer;
  1401. ANewBidName: string);
  1402. var i: Integer;
  1403. vTree: TsdIDTree;
  1404. vRec: TsdDataRecord;
  1405. begin
  1406. if (CurRec <> nil) and
  1407. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1408. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1409. (CurRec.ValueByName('Type').AsInteger = 1) then
  1410. begin
  1411. if (CurRec.ValueByName('Name').AsString <> ANewBidName) then
  1412. begin
  1413. CurRec.ValueByName('Name').AsString := ANewBidName;
  1414. ProjectManager.Save;
  1415. end;
  1416. Exit;
  1417. end;
  1418. vTree := stdProjects.IDTree;
  1419. for i := 0 to vTree.Count - 1 do
  1420. begin
  1421. vRec := vTree.Items[i].Rec;
  1422. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1423. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1424. (vRec.ValueByName('Type').AsInteger = 1) then
  1425. begin
  1426. if vRec.ValueByName('Name').AsString <> ANewBidName then
  1427. begin
  1428. vRec.ValueByName('Name').AsString := ANewBidName;
  1429. ProjectManager.Save;
  1430. end;
  1431. Break;
  1432. end;
  1433. end;
  1434. end;
  1435. function TProjectManagerFrame.CurRecAttachmentPath: string;
  1436. begin
  1437. if G_IsCloud then
  1438. Result := PHPWeb.WebPath + 'Projects\' + CurRec.ValueByName('WebID').AsString + '\Attachment\'
  1439. else
  1440. Result := GetMyProjectsFilePath + 'Attachment\' + CurRec.ValueByName('FileName').AsString + '\';
  1441. end;
  1442. function TProjectManagerFrame.AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
  1443. function GetCount(ANode: TsdIDTreeNode): Integer;
  1444. var sPath: string;
  1445. begin
  1446. if not Assigned(ANode) then Exit;
  1447. Result := 0;
  1448. if ANode.Rec.ValueByName('Type').AsInteger = 0 then
  1449. Result := Result + 0
  1450. else
  1451. begin
  1452. sPath := GetMyProjectsFilePath + 'Attachment\' + ANode.Rec.ValueByName('FileName').AsString + '\';
  1453. Result := Result + FileCount(sPath) - 1;
  1454. end;
  1455. if Assigned(ANode.FirstChild) then
  1456. Result := Result + GetCount(ANode.FirstChild);
  1457. if Assigned(ANode.NextSibling) then
  1458. Result := Result + GetCount(ANode.NextSibling);
  1459. end;
  1460. begin
  1461. if not Assigned(ANode) then Exit;
  1462. if Assigned(ANode.FirstChild) then
  1463. Result := GetCount(ANode.FirstChild)
  1464. else
  1465. Result := 0;
  1466. end;
  1467. procedure TProjectManagerFrame.BubbleSortProjects;
  1468. // 不能排最顶层
  1469. procedure BubbleSort(ANode: TsdIDTreeNode);
  1470. var n, t, c, temp: Integer;
  1471. bSwap: Boolean;
  1472. vNode1, vNode2, vTempNode: TsdIDTreeNode;
  1473. begin
  1474. if ANode = nil then Exit;
  1475. // if ANode.Rec.ValueByName('WebFolderLevel').AsInteger = G_WFL_ProjName then Exit;
  1476. n := ANode.ChildCount;
  1477. for t := 1 to n - 1 do
  1478. begin
  1479. bSwap := False;
  1480. for c := 1 to (n - t) do
  1481. begin
  1482. vNode1 := ANode.ChildNodes[c - 1];
  1483. vNode2 := ANode.ChildNodes[c];
  1484. if AnsiCompareStr(vNode1.Rec.ValueByName('Name').AsString,
  1485. vNode2.Rec.ValueByName('Name').AsString) = 1 then
  1486. begin
  1487. vNode1.DownMove;
  1488. bSwap := True;
  1489. end;
  1490. end;
  1491. if bSwap = False then Break;
  1492. end;
  1493. if Assigned(ANode.FirstChild) then
  1494. BubbleSort(ANode.FirstChild);
  1495. if Assigned(ANode.NextSibling) then
  1496. BubbleSort(ANode.NextSibling);
  1497. end;
  1498. begin
  1499. BubbleSort(stdProjects.IDTree.FirstNode);
  1500. end;
  1501. end.