ProjectManagerFme.pas 50 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665
  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. begin
  223. Result := False;
  224. // 先按正常接口找到最新的MD5码看是否需要更新
  225. sSearchURL := Format('%stender/get/%d/update', [PHPWeb.MeasureURL, FWebID]);
  226. iSearch := SearchFileOnline(sSearchURL, sDownURL, sFolder, sSubFolder, sNewName, sMD5, sError, iFolderID, iSubFolderID);
  227. if iSearch = 1 then
  228. begin
  229. try
  230. CheckWebFolders(iFolderID, iSubFolderID, sFolder, sSubFolder);
  231. CheckBidName(FID, sNewName);
  232. finally
  233. if vSel <> nil then
  234. vSel.LocateInControl;
  235. end;
  236. // 打开前一定要先下载最新的标段文件(无论审核有没有通过)
  237. if sMD5 <> FWebMD5 then
  238. begin
  239. // 下载
  240. sLocalFile := PHPWeb.UserPath + ExtractFileName(sDownURL);
  241. if not PHPWeb.DownFile(sDownURL, sLocalFile) then
  242. begin
  243. sHint := Format('云端已找到"%s"的新文件,但由于网络原因下载失败,请重试!', [FBidName]);
  244. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  245. Exit;
  246. end;
  247. // 接收更新
  248. bLock := (FWebAuthorID = PHPWeb.UserID) or ((FWebAuthorID <> PHPWeb.UserID) and (FMyCheckStatus <> csChecking));
  249. if not ReceiveFile(sLocalFile, sMD5, bLock) then
  250. begin
  251. sHint := Format('已从云端下载新的"%s"到本地[%s],但接收失败,请删除该项目然后重新从云端获取!', [FBidName, sLocalFile]);
  252. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  253. Exit;
  254. end;
  255. end;
  256. // 编制人且项目末通过
  257. if (FWebAuthorID = PHPWeb.UserID) and (FProjectCheckStatus = csNotPass) then
  258. begin
  259. sHint := '本期计量审批不通过,你现在可以:' + #10#13 +
  260. '点击【是(Y)】重新开始本期计量,软件将打开本期上报时的数据,开始重新计量;' + #10#13 +
  261. '点击【否(N)】查看不通过计量,软件将打开本期最后审批的数据,重新打开标段' +
  262. '可再次打开本确认窗口。';
  263. if Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION) = ID_Yes then
  264. begin
  265. sSearchURL := Format('%suser/create/%d/%d/new/audit', [PHPWeb.MeasureURL, FWebID, FPhaseNo]);
  266. case SearchFileOnline(sSearchURL, sDownURL, sFolder, sSubFolder, sNewName, sMD5_UnLock, sError, iFolderID, iSubFolderID) of
  267. 1: {注意这里的MD5码应取最终审核不通过项目的,否则会带来下载循环问题。
  268. 问题描述:
  269. ①编制人运行软件,双击项目,发现审核不通过,自动下载无锁文件,开始新一期,保存关闭。
  270. ②编制人再次运行软件,双击项目,MD5码不同,自动下载旧的审核不通过文件,覆盖本地。
  271. ③编制人再次运行软件,双击项目,发现审核不通过,重复①,循环....
  272. 问:①那里下载无锁文件后不能改成新的MD5码吗?
  273. 答:不能,因为审核人的项目会变成无锁文件,看不到不通过项目。MD5码只能在上传后更新。
  274. 且编制人有个交互界面2种选择:a.下载更新不通过项目查看;b.下载更新无锁文件开始新一期。
  275. }
  276. begin
  277. // 下载
  278. sLocalFile := PHPWeb.UserPath + ExtractFileName(sDownURL);
  279. if not PHPWeb.DownFile(sDownURL, sLocalFile) then
  280. begin
  281. sHint := '云端已找到原报上传的无锁文件,但因网络出错无法下载,本次操作已取消。请重试!';
  282. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  283. Exit;
  284. end;
  285. // 导入更新-------------------------------------------------------
  286. // 导入前须检测无锁文件中仅含有原报数据
  287. vFileCheck := TTenderFileChecker.Create(sLocalFile);
  288. try
  289. // 有一期以上数据,且最新期数据审核状态为原报
  290. bCanImp := (vFileCheck.PhaseCount > 0) and (vFileCheck.AuditStatus = 0);
  291. if not bCanImp then
  292. begin
  293. Application.MessageBox(PChar('已从云端下载原报上传的无锁文件到本地,但文件有错误,禁止导入!请致电纵横服务人员以获取帮助。'), '警告', MB_OK + MB_ICONWARNING);
  294. Exit;
  295. end;
  296. finally
  297. vFileCheck.Free;
  298. end;
  299. if not ImportFile(sLocalFile, sMD5) then
  300. begin
  301. Application.MessageBox(PChar('已从云端下载原报上传的无锁文件到本地,但导入失败!请重试。'), '警告', MB_OK + MB_ICONWARNING);
  302. Exit;
  303. end;
  304. // 导入更新---------------------------------↑↑↑↑↑↑↑↑↑↑↑
  305. end;
  306. 0, -1:
  307. begin
  308. sHint := sError + '(因网络出错,无法连接到云端以获取本期原报上传的无锁文件,无法重新开始本期,本次操作已取消。请重试。';
  309. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  310. Exit;
  311. end;
  312. end;
  313. end;
  314. end;
  315. end
  316. // else if (iSearch = 10) then
  317. // begin
  318. // sHint :='该项目[' + FBidName + ']在云端已被删除,点击"确定"后,可手动删除该项目。';
  319. // Application.MessageBox(PChar(sHint), '系统提示', MB_OK + MB_ICONINFORMATION);
  320. // Exit;
  321. // end
  322. else if (iSearch = 0) or (iSearch = -1) then
  323. begin
  324. sHint := sError + '(因网络出错,无法检测[' + FBidName + ']在云端是否有更新,本次操作已取消,请重试)。';
  325. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  326. Exit;
  327. end;
  328. Result := True;
  329. end;
  330. begin
  331. // 打开前先下载更新
  332. Screen.Cursor := crHourGlass;
  333. try
  334. vSel := stdProjects.IDTree.Selected;
  335. vRec := vSel.Rec;
  336. if G_IsCloud then
  337. begin
  338. GetLocalValues;
  339. // 以下这段已经包含在MainForm.OpenProject(vRec)中了,但在调用这句之前,网络版要提前用一下。
  340. if MainForm.HasOpened(FID) then
  341. begin
  342. MainForm.LocateProject(FID);
  343. Exit;
  344. end;
  345. if not CanOpen then
  346. Exit;
  347. end;
  348. MainForm.OpenProject(vRec);
  349. if G_IsCloud then
  350. begin
  351. if not MainForm.CurProjectFrame.CheckFileAndCloudChekerList then
  352. begin
  353. sHint := '项目校验:“' + FBidName + '”文件中的审核人和云端的审核人不一致,' +
  354. '禁止继续操作,项目即将关闭!请删除本地项目重新从云端获取,' +
  355. '重新获取后如果仍然存在同样的问题,请联系纵横服务人员以寻求帮助。';
  356. Application.MessageBox(PChar(sHint), '文件错误', MB_OK +MB_ICONWARNING);
  357. MainForm.actnCloseProject.Execute;
  358. Exit;
  359. end;
  360. end;
  361. finally
  362. Screen.Cursor := crDefault;
  363. end;
  364. end;
  365. procedure TProjectManagerFrame.actnDeleteExecute(Sender: TObject);
  366. begin
  367. if stdProjects.IDTree.Count = 0 then Exit;
  368. with stdProjects.IDTree.Selected.Rec do
  369. if QuestMessage(Format('确定要删除[%s]吗?', [ValueByName('Name').AsString])) then
  370. begin
  371. Screen.Cursor := crHourGlass;
  372. try
  373. FProjectManagerData.Delete;
  374. finally
  375. Screen.Cursor := crDefault;
  376. end;
  377. end;
  378. end;
  379. procedure TProjectManagerFrame.zgProjectsMouseDown(Sender: TObject;
  380. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  381. begin
  382. if Button = mbRight then
  383. dxpmProjectManager.PopupFromCursorPos
  384. else if (zgProjects.CurCol = 1) and (Button = mbLeft) and (ssDouble in Shift)
  385. and Assigned(stdProjects.IDTree.Selected) then
  386. begin
  387. if IsProject(stdProjects.IDTree.Selected) then
  388. stdProjects.IDTree.Selected.Expand
  389. else
  390. actnOpen.Execute;
  391. end;
  392. end;
  393. function TProjectManagerFrame.ReceiveFile(const AFileName: string; AFileMD5: string;
  394. ANeedLock: Boolean): Boolean;
  395. var
  396. Recevier: TReceiveProject;
  397. vNode: TsdIDTreeNode;
  398. begin
  399. Result := False;
  400. Recevier := TReceiveProject.Create(stdProjects.IDTree.Selected);
  401. try
  402. try
  403. if G_IsCloud then
  404. Recevier.Lock := ANeedLock;
  405. ProjectManager.RefreshSeedID;
  406. vNode := Recevier.Receive(AFileName);
  407. if G_IsCloud then
  408. begin
  409. vNode.Rec.BeginUpdate;
  410. vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5;
  411. vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
  412. vNode.Rec.EndUpdate;
  413. end;
  414. vNode.LocateInControl;
  415. Result := True;
  416. except
  417. Result := False;
  418. end;
  419. finally
  420. if Recevier.MessageID = 1 then
  421. ErrorMessage('当前标段处于打开状态,未能成功接收,请先关闭标段再次接收。');
  422. Recevier.Free;
  423. FProjectManagerData.Save;
  424. end;
  425. end;
  426. // 登录后自动扫描等待我审核的项目 TagC
  427. procedure TProjectManagerFrame.actnReceiveProjectExecute(Sender: TObject);
  428. procedure DoReceiveLocal;
  429. var
  430. sFileName: string;
  431. begin
  432. if SelectFile(sFileName, '.rmf;*.arf') then
  433. begin
  434. ShowProgressHint('正在接收项目并升级数据');
  435. try
  436. ReceiveFile(sFileName);
  437. finally
  438. CloseProgressHint;
  439. end;
  440. end;
  441. end;
  442. var OnCC: TZjCellNotifyEvent;
  443. begin
  444. Screen.Cursor := crHourGlass;
  445. try
  446. if G_IsCloud then
  447. begin
  448. OnCC := zgProjects.OnCurrentChanged;
  449. try
  450. zgProjects.OnCurrentChanged := nil;
  451. DoBatchReceiveOnline(1);
  452. if stdProjects.IDTree.FirstNode <> nil then
  453. stdProjects.IDTree.FirstNode.LocateInControl;
  454. finally
  455. zgProjects.OnCurrentChanged := OnCC;
  456. end;
  457. end
  458. else
  459. DoReceiveLocal;
  460. finally
  461. Screen.Cursor := crDefault;
  462. end;
  463. end;
  464. function TProjectManagerFrame.GetImportProjectName(
  465. const AFileName: string; AParent: TsdIDTreeNode): string;
  466. begin
  467. Result := ExtractSimpleFileName(AFileName);
  468. while FProjectManagerData.ExistProject(Result, AParent) do
  469. if not InputNewProjectName(Result, '导入', AParent) then Abort;
  470. end;
  471. procedure TProjectManagerFrame.actnNewProjectExecute(Sender: TObject);
  472. var
  473. sName: string;
  474. begin
  475. if G_IsCloud then Exit; // 云版线上与本地要保持同步,不允许本地新建
  476. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  477. FProjectManagerData.InsertProject(sName, stdProjects.IDTree.Selected);
  478. end;
  479. procedure TProjectManagerFrame.actnNewSubProjectExecute(Sender: TObject);
  480. var
  481. sName: string;
  482. begin
  483. if G_IsCloud then Exit;
  484. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  485. FProjectManagerData.InsertSubProject(sName, stdProjects.IDTree.Selected);
  486. end;
  487. procedure TProjectManagerFrame.actnNewTenderExecute(Sender: TObject);
  488. function AddAndOpenTender(const ATenderName: string): TsdIDTreeNode;
  489. begin
  490. Result := FProjectManagerData.InsertTender(ATenderName, stdProjects.IDTree.Selected);
  491. MainForm.OpenProject(Result.Rec);
  492. end;
  493. // 网络版新建标段 TagD
  494. procedure NewProjectWithOnline;
  495. var
  496. WebNewTenderForm: TWebNewTenderForm;
  497. sName, sKey, sURL: string;
  498. stnNew: TsdIDTreeNode;
  499. iID, iFolderID, iSubFolderID: Integer;
  500. vRec: TsdDataRecord;
  501. vArr: array of string;
  502. begin
  503. WebNewTenderForm := TWebNewTenderForm.Create(nil);
  504. try
  505. WebNewTenderForm.ShowModal;
  506. if WebNewTenderForm.ModalResult = mrOK then
  507. begin
  508. sKey := WebNewTenderForm.edtKey.Text;
  509. sName := WebNewTenderForm.edtTenderName.Text;
  510. // 同服务器取得联系
  511. iID := -1;
  512. vArr := VarArrayOf(['catid', 'name', 'company', 'phone', 'mobile', 'qq',
  513. 'pname', 'ptype', 'jobs', 'avatar', 'ownuid', 'pnameid', 'ptypeid']);
  514. sURL := Format('%s%d/%s/%s/creatmeasure', [PHPWeb.MeasureURL, PHPWeb.UserID, sName, sKey]); // AnsiToUtf8(sName)
  515. case PHPWeb.Search(sURL, [], [], vArr) of
  516. 1:
  517. begin
  518. iID := StrToInt(vArr[0]);
  519. iFolderID := StrToInt(vArr[11]);
  520. iSubFolderID := StrToInt(vArr[12]);
  521. CheckWebFolders(iFolderID, iSubFolderID, vArr[6], vArr[7]);
  522. end;
  523. 0:
  524. begin
  525. Application.MessageBox(PChar(PHPWeb.PageError('创建标段失败' + '[' + vArr[0] + ']')),
  526. '警告', MB_OK + MB_ICONWARNING);
  527. Exit;
  528. end;
  529. -1:
  530. begin
  531. Application.MessageBox(PChar(PHPWeb.NetError('创建标段失败')),
  532. '警告', MB_OK + MB_ICONWARNING);
  533. Exit;
  534. end;
  535. end;
  536. // 本地创建
  537. stnNew := FProjectManagerData.InsertTender(sName, stdProjects.IDTree.Selected);
  538. // 这里把Web获取的信息存储到项目管理里面。
  539. vRec := stnNew.Rec;
  540. vRec.BeginUpdate;
  541. vRec.ValueByName('WebID').AsInteger := iID;
  542. vRec.ValueByName('WebOwnerID').AsInteger := StrToInt(vArr[10]); // 业主
  543. vRec.ValueByName('WebAuthorID').AsInteger := PHPWeb.UserID; // 编制人
  544. vRec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID; // 当前用户,用于只显示自己的项目
  545. vRec.ValueByName('WebKey').AsString := sKey;
  546. vRec.EndUpdate;
  547. GetLocalValues(vRec);
  548. FWebOwnerName := vArr[1];
  549. FWebOwnerCompany := vArr[2];
  550. FWebOwnerRole := vArr[8];
  551. FWebProjectName := vArr[6];
  552. FWebProjCtgyName := vArr[7];
  553. // WebOwnerImage := vArr[9];
  554. // WebOwnerPhone := vArr[3];
  555. // WebOwnerMobile := vArr[4];
  556. // WebOwnerQQ := vArr[5];
  557. ShowProjWebInfoTop(0);
  558. FProjectManagerData.Save;
  559. MainForm.OpenProject(vRec);
  560. end;
  561. finally
  562. WebNewTenderForm.Free;
  563. end;
  564. end;
  565. procedure NewProject;
  566. var
  567. sName: string;
  568. begin
  569. if InputNewProjectName(sName, '新建', stdProjects.IDTree.Selected) then
  570. AddAndOpenTender(sName);
  571. end;
  572. begin
  573. if G_IsCloud then
  574. NewProjectWithOnline
  575. else
  576. NewProject;
  577. end;
  578. procedure TProjectManagerFrame.zgProjectsDrawCellText(ACanvas: TCanvas;
  579. const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
  580. const Text: String; var ADefaultDraw: Boolean);
  581. procedure GetBitmap(AImage: TBitmap; ANode: TsdIDTreeNode);
  582. begin
  583. if Assigned(ANode) and Assigned(ANode.Rec) then
  584. begin
  585. if ANode.Rec.ValueByName('Type').AsInteger = 0 then
  586. if ANode.Expanded and ANode.HasChildren then
  587. MainForm.Images.GetBitmap(34, AImage)
  588. else
  589. MainForm.Images.GetBitmap(34, AImage)
  590. else
  591. MainForm.Images.GetBitmap(11, AImage);
  592. end
  593. else
  594. AImage := nil;
  595. end;
  596. const
  597. rIconWidth = 16;
  598. rIconHeight = 16;
  599. var
  600. Img: TBitmap;
  601. Cell: TZjCell;
  602. rImg: TRect;
  603. vNode: TsdIDTreeNode;
  604. begin
  605. if (ACoord.X = 1) and (ACoord.Y > zgProjects.FixedRowCount - 1) then
  606. begin
  607. Cell := zgProjects.Cells[ACoord.X, ACoord.Y];
  608. Img := TBitmap.Create;
  609. try
  610. vNode := stdProjects.IDTree.Items[ACoord.Y-zgProjects.FixedRowCount];
  611. GetBitmap(Img, vNode);
  612. case Cell.Align of
  613. gaTopLeft, gaTopCenter, gaTopRight:
  614. rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);
  615. gaCenterLeft, gaCenterCenter, gaCenterRight:
  616. 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);
  617. gaBottomLeft, gaBottomCenter, gaBottomRight:
  618. rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);
  619. end;
  620. ACanvas.StretchDraw(rImg, Img);
  621. WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)
  622. , 2, 2, Text, Cell.Align, False);
  623. ADefaultDraw := False;
  624. finally
  625. Img.Free;
  626. end;
  627. end;
  628. end;
  629. procedure TProjectManagerFrame.actnNewSubProjectUpdate(Sender: TObject);
  630. begin
  631. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  632. and IsProject(stdProjects.IDTree.Selected)
  633. and (not IsUnEmptyLeafProject(stdProjects.IDTree.Selected));
  634. end;
  635. procedure TProjectManagerFrame.actnNewTenderUpdate(Sender: TObject);
  636. var bCloud: Boolean;
  637. vNode: TsdIDTreeNode;
  638. begin
  639. bCloud := G_IsCloud;
  640. // 只有编制人才能创建新标段?逻辑先后有问题:编制人是在创建标段之后产生的。
  641. // 创建前,当前用户只是一个帐户,它是不是编制人末知,因为它还可以是其它角色。
  642. // 同一帐户在不同的标段可以作为不同的角色。
  643. if bCloud then
  644. begin
  645. TAction(Sender).Enabled := True;
  646. end
  647. else
  648. begin
  649. vNode := stdProjects.IDTree.Selected;
  650. TAction(Sender).Enabled := Assigned(vNode) and IsProject(vNode) and IsLeafProject(vNode);
  651. end;
  652. end;
  653. function TProjectManagerFrame.IsLeafProject(ANode: TsdIDTreeNode): Boolean;
  654. begin
  655. if ANode.HasChildren then
  656. Result := ANode.FirstChild.Rec.ValueByName('Type').AsInteger = 1
  657. else
  658. Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
  659. end;
  660. function TProjectManagerFrame.IsProject(ANode: TsdIDTreeNode): Boolean;
  661. begin
  662. Result := ANode.Rec.ValueByName('Type').AsInteger = 0;
  663. end;
  664. function TProjectManagerFrame.IsUnEmptyLeafProject(
  665. ANode: TsdIDTreeNode): Boolean;
  666. begin
  667. Result := ANode.HasChildren and (ANode.Rec.ValueByName('Type').AsInteger = 1);
  668. end;
  669. procedure TProjectManagerFrame.SetPropertyVisible(AVisible: Boolean);
  670. begin
  671. // 单击刷新项目信息 TagA
  672. if G_IsCloud then
  673. begin
  674. if CurRec = nil then Exit;
  675. pnlTenderProperty.Visible := False;
  676. pnlWeb.Visible := AVisible;
  677. if AVisible then
  678. begin
  679. CreateProgress('云端读取项目信息');
  680. try
  681. SearchAndShowProjAllWebInfo(CurRec);
  682. finally
  683. CloseProgress;
  684. end;
  685. end;
  686. end
  687. else
  688. begin
  689. pnlWeb.Visible := False;
  690. pnlTenderProperty.Visible := AVisible;
  691. sprProperty.Visible := AVisible;
  692. end;
  693. end;
  694. procedure TProjectManagerFrame.zgProjectsCurrentChanged(Sender: TObject;
  695. Col, Row: Integer);
  696. begin
  697. if G_IsCloud then
  698. begin
  699. if CurRec <> nil then
  700. begin
  701. // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
  702. // if FID <> CurRec.ValueByName('ID').AsInteger then
  703. SetPropertyVisible(CurRec.ValueByName('Type').AsInteger = 1);
  704. // OnCurrentChanged取得的 CurRec.ValueByName() 值并不总是可靠,这里加保险。
  705. // 如调用locateInControl后,执行到这里取得的CurRec.ValueByName('ID')值还是上一条的。
  706. if (CurRec.ValueByName('Type').AsInteger = 1) and (not pnlWeb.Visible) then
  707. pnlWeb.Visible := True;
  708. end;
  709. end;
  710. end;
  711. procedure TProjectManagerFrame.actnSubmitProjectUpdate(Sender: TObject);
  712. begin
  713. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  714. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1)
  715. and (stdProjects.IDTree.Selected.Rec.ValueByName('AuditStatus').AsInteger < iMaxStageCount-1);
  716. end;
  717. procedure TProjectManagerFrame.actnReplyProjectUpdate(Sender: TObject);
  718. begin
  719. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  720. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  721. end;
  722. procedure TProjectManagerFrame.actnRenameExecute(Sender: TObject);
  723. function CanRename(ARec: TsdDataRecord; const ANewName: string): Boolean;
  724. var
  725. sURL: string;
  726. iRename: Integer;
  727. vArr: array of string;
  728. begin
  729. Result := True;
  730. if not G_IsCloud then Exit;
  731. // 云版 重命名须确保同步服务器
  732. sURL := Format('%stender/%d/%s/update', [PHPWeb.MeasureURL, ARec.ValueByName('WebID').AsInteger, ANewName]);
  733. iRename := PHPWeb.Search(sURL, [], [], vArr);
  734. Result := iRename = 1;
  735. case iRename of
  736. 1: ShowMessage('新的标段名称已同步到服务器!');
  737. 0: Application.MessageBox(PChar(PHPWeb.PageError('重命名同步到云端失败' + '[' + vArr[0] + ']')),
  738. '警告', MB_OK + MB_ICONWARNING);
  739. -1: Application.MessageBox(PChar(PHPWeb.NetError('重命名同步到云端失败')),
  740. '警告', MB_OK + MB_ICONWARNING);
  741. end;
  742. end;
  743. var
  744. stnNode: TsdIDTreeNode;
  745. sName: string;
  746. begin
  747. stnNode := stdProjects.IDTree.Selected;
  748. sName := stnNode.Rec.ValueByName('Name').AsString;
  749. if not Assigned(OpenProjectManager.FindProjectData(stnNode.ID)) then
  750. begin
  751. if InputNewProjectName(sName, '重命名', stnNode.Parent, stnNode.ID) then
  752. begin
  753. if CanRename(stnNode.Rec, sName) then
  754. begin
  755. stnNode.Rec.ValueByName('Name').AsString := sName;
  756. ProjectManager.Save;
  757. end;
  758. end;
  759. end
  760. else
  761. ErrorMessage(Format('项目[%s]已经打开,无法重命名!', [sName]));
  762. end;
  763. procedure TProjectManagerFrame.actnOpenUpdate(Sender: TObject);
  764. begin
  765. TAction(Sender).Enabled := Assigned(stdProjects.IDTree.Selected)
  766. and (stdProjects.IDTree.Selected.Rec.ValueByName('Type').AsInteger = 1);
  767. end;
  768. procedure TProjectManagerFrame.actnImportExecute(Sender: TObject);
  769. procedure ImportTender(const AFileName, AProjectName: string);
  770. var
  771. Importor: TTenderImport;
  772. begin
  773. Importor := TTenderImport.Create(stdProjects.IDTree.Selected,
  774. AProjectName, AFileName);
  775. try
  776. Importor.Execute;
  777. finally
  778. Importor.Free;
  779. end;
  780. end;
  781. procedure ImportProject(const AFileName, AProjectName: string);
  782. var
  783. Importor: TProjectImport;
  784. begin
  785. Importor := TProjectImport.Create(stdProjects.IDTree.Selected,
  786. AProjectName, AFileName);
  787. try
  788. Importor.Execute;
  789. finally
  790. Importor.Free;
  791. end;
  792. end;
  793. var
  794. sFileName, sProjectName: string;
  795. vCur: TsdIDTreeNode;
  796. begin
  797. if SelectFile(sFileName, '.mtf;*.mpf') then
  798. begin
  799. vCur := stdProjects.IDTree.Selected;
  800. if Assigned(vCur) then
  801. begin
  802. if SameText(ExtractFileExt(sFileName), '.mtf')
  803. and (vCur.Rec.ValueByName('Type').AsInteger = 0) then
  804. sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected)
  805. else
  806. sProjectName := GetImportProjectName(sFileName, stdProjects.IDTree.Selected.Parent);
  807. end
  808. else
  809. sProjectName := GetImportProjectName(sFileName, vCur);
  810. Screen.Cursor := crHourGlass;
  811. try
  812. if SameText(ExtractFileExt(sFileName), '.mtf') then
  813. ImportTender(sFileName, sProjectName)
  814. else
  815. ImportProject(sFileName, sProjectName);
  816. finally
  817. Screen.Cursor := crDefault;
  818. end;
  819. end;
  820. FProjectManagerData.Save;
  821. end;
  822. procedure TProjectManagerFrame.actnExportExecute(Sender: TObject);
  823. procedure ExportTender(ANode: TsdIDTreeNode);
  824. var
  825. Exportor: TTenderExport;
  826. sFileName, sHint: string;
  827. bExpAtch: Boolean;
  828. iCount: Integer;
  829. begin
  830. bExpAtch := False;
  831. sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mtf';
  832. if SaveFile(sFileName, '.mtf') then
  833. begin
  834. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  835. Exit;
  836. Screen.Cursor := crHourGlass;
  837. try
  838. Exportor := TTenderExport.Create(ANode.Rec, sFileName);
  839. try
  840. { if not G_IsCloud then
  841. begin
  842. iCount := FileCount(CurRecAttachmentPath);
  843. if iCount > 1 then // 排除管理文件库
  844. begin
  845. sHint := Format('本标段包含 %d 个附件,是否将附件一起导出?', [iCount - 1]);
  846. bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
  847. end;
  848. end; } // FFFFF
  849. Exportor.Execute(bExpAtch);
  850. finally
  851. Exportor.Free;
  852. end;
  853. finally
  854. Screen.Cursor := crDefault;
  855. end;
  856. end;
  857. end;
  858. procedure ExportProject(ANode: TsdIDTreeNode);
  859. var
  860. Exportor: TProjectExport;
  861. sFileName, sHint: string;
  862. bExpAtch: Boolean;
  863. iCount: Integer;
  864. begin
  865. sFileName := SupportManager.ConfigInfo.OutputPath + ANode.Rec.ValueByName('Name').AsString + '.mpf';
  866. if SaveFile(sFileName, '.mpf') then
  867. begin
  868. if FileExists(sFileName) and not QuestMessage(Format('存在同名文件“%s”,是否替换?', [ExtractFileName(sFileName)])) then
  869. Exit;
  870. Screen.Cursor := crHourGlass;
  871. try
  872. bExpAtch := False;
  873. { if not G_IsCloud then
  874. begin
  875. iCount := AttachmentFileCountsWithoutManageFile(ANode);
  876. if iCount > 0 then
  877. begin
  878. sHint := Format('本建设项目共包含 %d 个附件,是否将附件一起导出?', [iCount]);
  879. bExpAtch := Application.MessageBox(PChar(sHint), '询问', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = ID_Yes;
  880. end;
  881. end; } // FFFFF
  882. Exportor := TProjectExport.Create(ANode, sFileName, bExpAtch);
  883. try
  884. Exportor.Execute;
  885. finally
  886. Exportor.Free;
  887. end;
  888. finally
  889. Screen.Cursor := crDefault;
  890. end;
  891. end;
  892. end;
  893. var
  894. stnNode: TsdIDTreeNode;
  895. begin
  896. stnNode := stdProjects.IDTree.Selected;
  897. if stnNode.Rec.ValueByName('Type').AsInteger = 1 then
  898. begin
  899. ExportTender(stnNode);
  900. end
  901. else
  902. ExportProject(stnNode);
  903. end;
  904. procedure TProjectManagerFrame.actnDeleteUpdate(Sender: TObject);
  905. begin
  906. if Assigned(stdProjects.IDTree.Selected) then
  907. TAction(Sender).Enabled := not CheckOpened(stdProjects.IDTree.Selected);
  908. end;
  909. function TProjectManagerFrame.CheckOpened(ANode: TsdIDTreeNode): Boolean;
  910. var
  911. iChild: Integer;
  912. begin
  913. Result := False;
  914. if ANode.Rec.ValueByName('Type').AsInteger = 1 then
  915. Result := OpenProjectManager.ProjectIndex(ANode.ID) > -1
  916. else
  917. begin
  918. if not ANode.HasChildren then
  919. Result := False
  920. else
  921. begin
  922. for iChild := 0 to ANode.ChildCount - 1 do
  923. Result := Result or CheckOpened(ANode.ChildNodes[iChild]);
  924. end
  925. end;
  926. end;
  927. procedure TProjectManagerFrame.SearchAndShowProjAllWebInfo(ARec: TsdDataRecord);
  928. var
  929. vPSArr: array[0..7] of string;
  930. vCArr: TOVArr; // Checkers
  931. vChecker: TOrderCheckerFrame;
  932. sPicPath, sURL: string;
  933. procedure AddChecker(AType: TCheckerFrameType; AArr: array of string);
  934. begin
  935. vChecker := TOrderCheckerFrame.Create(self);
  936. FCheckerList.Add(vChecker);
  937. vChecker.Owner := Self;
  938. sbChecker.VertScrollBar.Range := sbChecker.VertScrollBar.Range + vChecker.Height;
  939. sbChecker.Height := Min(sbChecker.Height + vChecker.Height, pnlWeb.Height - pnlProject.Height);
  940. vChecker.Parent := sbChecker;
  941. vChecker.Top := FCurPos;
  942. FCurPos := FCurPos + vChecker.Height;
  943. vChecker.Align := alTop;
  944. sPicPath := PHPWeb.UserPath + '1_' + AArr[0] + '.jpg';
  945. PHPWeb.DownFile(AArr[4], sPicPath);
  946. vChecker.Init(AType, StrToInt(AArr[0]), AArr[1], AArr[3],
  947. AArr[2], sPicPath, AArr[6], TCheckStatus(StrToInt(AArr[5])-1));
  948. vChecker.Name := 'ProjectOrderFrame' + AArr[0];
  949. end;
  950. procedure RepairOrder;
  951. var k: Integer;
  952. begin
  953. for k := 0 to sbChecker.ControlCount - 1 do
  954. TOrderCheckerFrame(sbChecker.Controls[k]).Order := k + 1;
  955. end;
  956. procedure RefreshProjectCheckers;
  957. var i, j: Integer;
  958. vOwner: array[0..6] of string; // 业主信息
  959. begin
  960. FCheckerList.Clear;
  961. sbChecker.Height := 0;
  962. FCurPos := 0;
  963. sbChecker.VertScrollBar.Range := 0;
  964. for i := Low(vCArr) to High(vCArr) do
  965. begin
  966. if StrToInt(vCArr[i, 0]) = PHPWeb.UserID then
  967. FMyCheckStatus := TCheckStatus(StrToInt(vCArr[i, 5])-1);
  968. if StrToInt(vCArr[i, 0]) = FWebOwnerID then
  969. begin
  970. for j := 0 to 6 do
  971. vOwner[j] := vCArr[i, j];
  972. Continue;
  973. end;
  974. AddChecker(cftChecker, vCArr[i]);
  975. end;
  976. if vOwner[0] <> '' then
  977. AddChecker(cftOwner, vOwner);
  978. RepairOrder;
  979. end;
  980. begin
  981. GetLocalValues(ARec);
  982. if FWebID = 0 then Exit;
  983. sURL := Format('%smeasure/status/%d/get', [PHPWeb.MeasureURL, FWebID]);
  984. if PHPWeb.Search(sURL, [''], [''], 3, vPSArr, vCArr) = 1 then
  985. begin
  986. LockWindowUpdate(pnlWeb.Handle);
  987. try
  988. FPhaseNo := StrToInt(vPSArr[0]);
  989. FProjectCheckStatus := TCheckStatus(StrToInt(vPSArr[1])-1);
  990. FPhaseTotal := StrToInt(vPSArr[2]);
  991. FWebProjectName := vPSArr[3];
  992. FWebProjCtgyName := vPSArr[4];
  993. FWebOwnerName := vPSArr[5];
  994. FWebOwnerCompany := vPSArr[6];
  995. FWebOwnerRole := vPSArr[7];
  996. ShowProjWebInfoTop;
  997. RefreshProjectCheckers;
  998. finally
  999. LockWindowUpdate(0);
  1000. end;
  1001. end
  1002. else
  1003. begin
  1004. FPhaseNo := 0;
  1005. FProjectCheckStatus := csNotBegin;
  1006. FPhaseTotal := 0;
  1007. FWebProjectName := '';
  1008. FWebProjCtgyName := '';
  1009. FWebOwnerName := '';
  1010. FWebOwnerCompany := '';
  1011. FWebOwnerRole := '';
  1012. ShowProjWebInfoTop;
  1013. sbChecker.Height := 0;
  1014. end;
  1015. end;
  1016. procedure TProjectManagerFrame.ShowProjWebInfoTop(AType: Integer);
  1017. procedure ShowOwner;
  1018. begin
  1019. lblBidName.Caption := FBidName;
  1020. lblBidName.Update;
  1021. lblProjName.Caption := FWebProjectName;
  1022. lblProjName.Update;
  1023. lblWebProjCtgyName.Caption := FWebProjCtgyName;
  1024. lblWebProjCtgyName.Update;
  1025. lblOnwerName.Caption := FWebOwnerName;
  1026. lblOnwerName.Update;
  1027. lblOnwerCompany.Caption := Format('-%s)', [FWebOwnerCompany]);
  1028. lblOnwerCompany.Update;
  1029. lblOnwerCompany.Left := lblOnwerName.Left + lblOnwerName.Width;
  1030. end;
  1031. procedure ShowStatus(ANo: Integer; AState: TCheckStatus);
  1032. begin
  1033. lblPeriod.Caption := Format('第%d期', [ANo]);
  1034. lblPeriod.Update;
  1035. lblPeriodState.Caption := CheckStatusNames[AState];
  1036. lblPeriodState.Font.Color := CheckStatusColors[AState];
  1037. lblPeriodState.Update;
  1038. lblPeriodState.Left := lblPeriod.Left + lblPeriod.Width + 5;
  1039. lblPeriodTotal.Caption := Format('(共%d期)', [ANo]);
  1040. lblPeriodTotal.Update;
  1041. lblPeriodTotal.Left := lblPeriodState.Left + lblPeriodState.Width + 3;
  1042. end;
  1043. begin
  1044. GetLocalValues;
  1045. case AType of
  1046. -2:
  1047. begin
  1048. lblPeriod.Caption := '正在从云端读取状态信息...';
  1049. lblPeriod.Update;
  1050. end;
  1051. -1:
  1052. begin
  1053. ShowOwner;
  1054. ShowStatus(FPhaseNo, FProjectCheckStatus);
  1055. end;
  1056. 0:
  1057. begin
  1058. ShowOwner;
  1059. ShowStatus(0, csNotBegin);
  1060. end;
  1061. end;
  1062. end;
  1063. // 检查后,应该定位到最后一层目录,不应该回到原先的选择节点。否则从网络拉下来的项目无法组织正确的树结构。
  1064. procedure TProjectManagerFrame.CheckWebFolders(AFolderID, ASubFolderID: Integer;
  1065. AFolderName, ASubFolderName: string);
  1066. var
  1067. vTree: TsdIDTree;
  1068. vNode, vSubNode: TsdIDTreeNode;
  1069. i: Integer;
  1070. sName: string;
  1071. iUserID, iWebID, iWebFolderLevel: Integer;
  1072. bExist, bSubExist, bModified: Boolean;
  1073. begin
  1074. bExist := False;
  1075. bSubExist := False;
  1076. bModified := False;
  1077. vTree := stdProjects.IDTree;
  1078. for i := 0 to vTree.Count - 1 do
  1079. begin
  1080. vNode := vTree.Items[i];
  1081. sName := vNode.Rec.ValueByName('Name').AsString;
  1082. iUserID := vNode.Rec.ValueByName('WebUserID').AsInteger;
  1083. iWebID := vNode.Rec.ValueByName('WebID').AsInteger;
  1084. iWebFolderLevel := vNode.Rec.ValueByName('WebFolderLevel').AsInteger;
  1085. if (iWebID = AFolderID) and (iWebFolderLevel = G_WFL_ProjName) and (iUserID = PHPWeb.UserID) then
  1086. begin
  1087. bExist := True;
  1088. vNode.LocateInControl;
  1089. if not SameText(sName, AFolderName) then
  1090. begin
  1091. vNode.Rec.ValueByName('Name').AsString := AFolderName;
  1092. bModified := True;
  1093. end;
  1094. Break;
  1095. end;
  1096. end;
  1097. if not bExist then
  1098. begin
  1099. vNode := vTree.Items[0];
  1100. if Assigned(vNode) then
  1101. vNode.LocateInControl;
  1102. vNode := FProjectManagerData.InsertProject(AFolderName, stdProjects.IDTree.Selected, AFolderID, G_WFL_ProjName);
  1103. vNode.LocateInControl;
  1104. end;
  1105. for i := 0 to vNode.ChildCount - 1 do
  1106. begin
  1107. vSubNode := vNode.ChildNodes[i];
  1108. sName := vSubNode.Rec.ValueByName('Name').AsString;
  1109. iUserID := vSubNode.Rec.ValueByName('WebUserID').AsInteger;
  1110. iWebID := vSubNode.Rec.ValueByName('WebID').AsInteger;
  1111. iWebFolderLevel := vSubNode.Rec.ValueByName('WebFolderLevel').AsInteger;
  1112. if (iWebID = ASubFolderID) and (iWebFolderLevel = G_WFL_BidType) and (iUserID = PHPWeb.UserID) then
  1113. begin
  1114. bSubExist := True;
  1115. vSubNode.LocateInControl;
  1116. if not SameText(sName, ASubFolderName) then
  1117. begin
  1118. vSubNode.Rec.ValueByName('Name').AsString := ASubFolderName;
  1119. bModified := True;
  1120. end;
  1121. Break;
  1122. end;
  1123. end;
  1124. if not bSubExist then
  1125. begin
  1126. vNode.LocateInControl;
  1127. vNode := FProjectManagerData.InsertSubProject(ASubFolderName, stdProjects.IDTree.Selected, ASubFolderID, G_WFL_BidType);
  1128. vNode.LocateInControl;
  1129. end;
  1130. if bModified then
  1131. ProjectManager.Save;
  1132. end;
  1133. function TProjectManagerFrame.Rec(AProjectID: Integer): TsdDataRecord;
  1134. var i: Integer;
  1135. vTree: TsdIDTree;
  1136. begin
  1137. vTree := stdProjects.IDTree;
  1138. if vTree.Selected.Rec.ValueByName('ID').AsInteger = AProjectID then
  1139. begin
  1140. Result := stdProjects.IDTree.Selected.Rec;
  1141. Exit;
  1142. end;
  1143. for i := 0 to vTree.Count - 1 do
  1144. begin
  1145. if vTree.Items[i].Rec.ValueByName('ID').AsInteger = AProjectID then
  1146. begin
  1147. Result := vTree.Items[i].Rec;
  1148. vTree.Items[i].LocateInControl;
  1149. Break;
  1150. end;
  1151. end;
  1152. end;
  1153. destructor TProjectManagerFrame.Destroy;
  1154. begin
  1155. FCheckerList.Free;
  1156. inherited;
  1157. end;
  1158. procedure TProjectManagerFrame.DoBatchReceiveOnline(ARequestType: Integer);
  1159. var
  1160. sURL, sFolder, sSubFolder, sMD5, sName, sHint, sLocalFile: string;
  1161. vMyCheckStatus: TCheckStatus;
  1162. vArr: TOVArr;
  1163. bLock: Boolean;
  1164. i, iWebID, iFolderID, iSubFolderID, iAuthorID: Integer;
  1165. begin
  1166. // 查询等待我审核的标段文件,杰哥说分三种:①业主未审核 ②业主审核中 ③审核人审核中 (为什么加①?问杰哥)
  1167. case PHPWeb.Search(PHPWeb.MeasureURL + 'user/get/audit/project', ['audituid', 'RequestType'],
  1168. [IntToStr(PHPWeb.UserID), IntToStr(ARequestType)], vArr) of
  1169. 1:
  1170. begin
  1171. CreateProgress('正在从云端下载新项目');
  1172. try
  1173. for i := Low(vArr) to High(vArr) do
  1174. begin
  1175. sURL := vArr[i, 0];
  1176. sFolder := vArr[i, 1];
  1177. sSubFolder := vArr[i, 2];
  1178. sMD5 := vArr[i, 3];
  1179. iWebID := StrToInt(vArr[i, 5]);
  1180. iFolderID := StrToInt(vArr[i, 6]);
  1181. iSubFolderID := StrToInt(vArr[i, 7]);
  1182. vMyCheckStatus := TCheckStatus(StrToInt(vArr[i, 8])-1); // vArr[i, 4]项目审核状态;vArr[i, 8]当前登陆用户的审核状态
  1183. iAuthorID := StrToInt(vArr[i, 9]); // 编制人ID
  1184. sName := vArr[i, 10]; // 标段名称
  1185. CheckWebFolders(iFolderID, iSubFolderID, sFolder, sSubFolder);
  1186. CheckBidName(PHPWeb.UserID, iWebID, sName);
  1187. if sMD5 <> LocalMD5(PHPWeb.UserID, iWebID) then
  1188. begin
  1189. // 下载
  1190. sLocalFile := PHPWeb.UserPath + ExtractFileName(sURL);
  1191. if not PHPWeb.DownFile(sURL, sLocalFile) then
  1192. begin
  1193. sHint := Format('云端已找到"%s"的新文件,但由于网络原因下载失败!请点击菜单“同步更新我参与的全部项目”重新下载!', [sName]);
  1194. Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
  1195. end;
  1196. // 接收更新
  1197. bLock := (iAuthorID = PHPWeb.UserID) or ((iAuthorID <> PHPWeb.UserID) and (vMyCheckStatus <> csChecking));
  1198. if not ReceiveFile(sLocalFile, sMD5, bLock) then
  1199. begin
  1200. sHint := Format('已从云端下载新的"%s"到本地,但接收失败,请删除该项目然后重新从云端获取!', [sName]);
  1201. Application.MessageBox(PChar(sHint), '系统提醒', MB_OK + MB_ICONWARNING);
  1202. Exit;
  1203. end;
  1204. end;
  1205. end;
  1206. BubbleSortProjects;
  1207. finally
  1208. CloseProgress;
  1209. end;
  1210. end;
  1211. 0, -1:
  1212. begin
  1213. sHint := '网络出错,无法查询云端项目的更新情况,请重试!';
  1214. Application.MessageBox(PChar(sHint), '警告', MB_OK + MB_ICONWARNING);
  1215. Exit;
  1216. end;
  1217. end;
  1218. end;
  1219. function TProjectManagerFrame.ImportFile(const AFileName: string; AFileMD5: string): Boolean;
  1220. var
  1221. vImport: TTenderImport;
  1222. vNode: TsdIDTreeNode;
  1223. begin
  1224. Result := False;
  1225. vNode := stdProjects.IDTree.Selected;
  1226. vImport := TTenderImport.Create(vNode, '', AFileName);
  1227. try
  1228. try
  1229. vImport.ImportToSelect;
  1230. vNode.LocateInControl;
  1231. Result := True;
  1232. except
  1233. Result := False;
  1234. end;
  1235. finally
  1236. vImport.Free;
  1237. vNode.Rec.BeginUpdate;
  1238. vNode.Rec.ValueByName('WebMD5').AsString := AFileMD5;
  1239. vNode.Rec.ValueByName('WebUserID').AsInteger := PHPWeb.UserID;
  1240. vNode.Rec.EndUpdate;
  1241. FProjectManagerData.Save;
  1242. end;
  1243. end;
  1244. procedure TProjectManagerFrame.actnOpenBackupFolderExecute(
  1245. Sender: TObject);
  1246. var
  1247. stnNode: TsdIDTreeNode;
  1248. begin
  1249. stnNode := stdProjects.IDTree.Selected;
  1250. if stnNode.Rec.ValueByName('BackupFolder').AsString = '' then
  1251. TipMessage('该项目暂无备份数据!')
  1252. else
  1253. ShellExecute(Handle, 'open', 'Explorer.exe',
  1254. PChar(FProjectManagerData.BackupPath(stnNode.ID)), nil, 1);
  1255. end;
  1256. procedure TProjectManagerFrame.actnRenameUpdate(Sender: TObject);
  1257. var
  1258. Rec: TsdDataRecord;
  1259. bNet: Boolean;
  1260. begin
  1261. if stdProjects.IDTree.Selected = nil then Exit;
  1262. Rec := stdProjects.IDTree.Selected.Rec;
  1263. if Rec = nil then Exit;
  1264. bNet := G_IsCloud;
  1265. if bNet then
  1266. begin
  1267. tobtnRenane.Enabled := (Rec.ValueByName('Type').AsInteger = 1) and
  1268. (Rec.ValueByName('WebAuthorID').AsInteger = PHPWeb.UserID);
  1269. end;
  1270. end;
  1271. procedure TProjectManagerFrame.CheckBidName(AID: Integer; ANewBidName: string);
  1272. var vNode: TsdIDTreeNode;
  1273. begin
  1274. vNode := stdProjects.IDTree.FindNode(AID);
  1275. if vNode = nil then Exit;
  1276. if vNode.Rec.ValueByName('Name').AsString <> ANewBidName then
  1277. begin
  1278. vNode.Rec.ValueByName('Name').AsString := ANewBidName;
  1279. ProjectManager.Save;
  1280. end;
  1281. end;
  1282. procedure TProjectManagerFrame.DoBatchReceiveAllOnline;
  1283. var
  1284. OnCC: TZjCellNotifyEvent;
  1285. begin
  1286. OnCC := zgProjects.OnCurrentChanged;
  1287. try
  1288. zgProjects.OnCurrentChanged := nil;
  1289. DoBatchReceiveOnline(2);
  1290. if stdProjects.IDTree.FirstNode <> nil then
  1291. stdProjects.IDTree.FirstNode.LocateInControl;
  1292. finally
  1293. zgProjects.OnCurrentChanged := OnCC;
  1294. end;
  1295. end;
  1296. procedure TProjectManagerFrame.GetLocalValues;
  1297. begin
  1298. GetLocalValues(CurRec);
  1299. end;
  1300. procedure TProjectManagerFrame.GetLocalValues(ARec: TsdDataRecord);
  1301. begin
  1302. if not Assigned(ARec) then
  1303. begin
  1304. ClearLocalValues;
  1305. Exit;
  1306. end;
  1307. // 加这句后产生Bug:上报项目后,记录不曾移动,FID不变,不会刷新
  1308. // if ARec.ValueByName('ID').AsInteger <> FID then
  1309. begin
  1310. FID := ARec.ValueByName('ID').AsInteger;
  1311. FWebID := ARec.ValueByName('WebID').AsInteger;
  1312. FWebAuthorID := ARec.ValueByName('WebAuthorID').AsInteger;
  1313. FWebOwnerID := ARec.ValueByName('WebOwnerID').AsInteger;
  1314. FWebMD5 := ARec.ValueByName('WebMD5').AsString;
  1315. FBidName := ARec.ValueByName('Name').AsString;
  1316. end;
  1317. end;
  1318. procedure TProjectManagerFrame.GetLocalValues(AUserID, AWebID: Integer);
  1319. var i: Integer;
  1320. vTree: TsdIDTree;
  1321. vRec: TsdDataRecord;
  1322. begin
  1323. ClearLocalValues; // 先清空,以防没找到。
  1324. if (CurRec <> nil) and
  1325. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1326. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1327. (CurRec.ValueByName('Type').AsInteger = 1) then
  1328. begin
  1329. GetLocalValues(vRec);
  1330. Exit;
  1331. end;
  1332. vTree := stdProjects.IDTree;
  1333. for i := 0 to vTree.Count - 1 do
  1334. begin
  1335. vRec := vTree.Items[i].Rec;
  1336. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1337. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1338. (vRec.ValueByName('Type').AsInteger = 1) then
  1339. begin
  1340. GetLocalValues(vRec);
  1341. Break;
  1342. end;
  1343. end;
  1344. end;
  1345. procedure TProjectManagerFrame.ClearLocalValues;
  1346. begin
  1347. FID := -1;
  1348. FWebID := -1;
  1349. FWebAuthorID := -1;
  1350. FWebOwnerID := -1;
  1351. FWebMD5 := '';
  1352. FBidName := '';
  1353. end;
  1354. function TProjectManagerFrame.LocalMD5(AUserID, AWebID: Integer): string;
  1355. var i: Integer;
  1356. vTree: TsdIDTree;
  1357. vRec: TsdDataRecord;
  1358. begin
  1359. Result := '本地无MD5码';
  1360. if (CurRec <> nil) and
  1361. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1362. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1363. (CurRec.ValueByName('Type').AsInteger = 1) then
  1364. begin
  1365. Result := vRec.ValueByName('WebMD5').AsString;
  1366. Exit;
  1367. end;
  1368. vTree := stdProjects.IDTree;
  1369. for i := 0 to vTree.Count - 1 do
  1370. begin
  1371. vRec := vTree.Items[i].Rec;
  1372. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1373. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1374. (vRec.ValueByName('Type').AsInteger = 1) then
  1375. begin
  1376. Result := vRec.ValueByName('WebMD5').AsString;
  1377. Break;
  1378. end;
  1379. end;
  1380. end;
  1381. function TProjectManagerFrame.CurRec: TsdDataRecord;
  1382. begin
  1383. if stdProjects.IDTree.Selected = nil then
  1384. Result := nil
  1385. else
  1386. Result := stdProjects.IDTree.Selected.Rec;
  1387. end;
  1388. procedure TProjectManagerFrame.CheckBidName(AUserID, AWebID: Integer;
  1389. ANewBidName: string);
  1390. var i: Integer;
  1391. vTree: TsdIDTree;
  1392. vRec: TsdDataRecord;
  1393. begin
  1394. if (CurRec <> nil) and
  1395. (CurRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1396. (CurRec.ValueByName('WebID').AsInteger = AWebID) and
  1397. (CurRec.ValueByName('Type').AsInteger = 1) then
  1398. begin
  1399. if (CurRec.ValueByName('Name').AsString <> ANewBidName) then
  1400. begin
  1401. CurRec.ValueByName('Name').AsString := ANewBidName;
  1402. ProjectManager.Save;
  1403. end;
  1404. Exit;
  1405. end;
  1406. vTree := stdProjects.IDTree;
  1407. for i := 0 to vTree.Count - 1 do
  1408. begin
  1409. vRec := vTree.Items[i].Rec;
  1410. if (vRec.ValueByName('WebUserID').AsInteger = AUserID) and
  1411. (vRec.ValueByName('WebID').AsInteger = AWebID) and
  1412. (vRec.ValueByName('Type').AsInteger = 1) then
  1413. begin
  1414. if vRec.ValueByName('Name').AsString <> ANewBidName then
  1415. begin
  1416. vRec.ValueByName('Name').AsString := ANewBidName;
  1417. ProjectManager.Save;
  1418. end;
  1419. Break;
  1420. end;
  1421. end;
  1422. end;
  1423. function TProjectManagerFrame.CurRecAttachmentPath: string;
  1424. begin
  1425. if G_IsCloud then
  1426. Result := PHPWeb.WebPath + 'Projects\' + CurRec.ValueByName('WebID').AsString + '\Attachment\'
  1427. else
  1428. Result := GetMyProjectsFilePath + 'Attachment\' + CurRec.ValueByName('FileName').AsString + '\';
  1429. end;
  1430. function TProjectManagerFrame.AttachmentFileCountsWithoutManageFile(ANode: TsdIDTreeNode): Integer;
  1431. function GetCount(ANode: TsdIDTreeNode): Integer;
  1432. var sPath: string;
  1433. begin
  1434. if not Assigned(ANode) then Exit;
  1435. Result := 0;
  1436. if ANode.Rec.ValueByName('Type').AsInteger = 0 then
  1437. Result := Result + 0
  1438. else
  1439. begin
  1440. sPath := GetMyProjectsFilePath + 'Attachment\' + ANode.Rec.ValueByName('FileName').AsString + '\';
  1441. Result := Result + FileCount(sPath) - 1;
  1442. end;
  1443. if Assigned(ANode.FirstChild) then
  1444. Result := Result + GetCount(ANode.FirstChild);
  1445. if Assigned(ANode.NextSibling) then
  1446. Result := Result + GetCount(ANode.NextSibling);
  1447. end;
  1448. begin
  1449. if not Assigned(ANode) then Exit;
  1450. if Assigned(ANode.FirstChild) then
  1451. Result := GetCount(ANode.FirstChild)
  1452. else
  1453. Result := 0;
  1454. end;
  1455. procedure TProjectManagerFrame.BubbleSortProjects;
  1456. // 不能排最顶层
  1457. procedure BubbleSort(ANode: TsdIDTreeNode);
  1458. var n, t, c, temp: Integer;
  1459. bSwap: Boolean;
  1460. vNode1, vNode2, vTempNode: TsdIDTreeNode;
  1461. begin
  1462. if ANode = nil then Exit;
  1463. // if ANode.Rec.ValueByName('WebFolderLevel').AsInteger = G_WFL_ProjName then Exit;
  1464. n := ANode.ChildCount;
  1465. for t := 1 to n - 1 do
  1466. begin
  1467. bSwap := False;
  1468. for c := 1 to (n - t) do
  1469. begin
  1470. vNode1 := ANode.ChildNodes[c - 1];
  1471. vNode2 := ANode.ChildNodes[c];
  1472. if AnsiCompareStr(vNode1.Rec.ValueByName('Name').AsString,
  1473. vNode2.Rec.ValueByName('Name').AsString) = 1 then
  1474. begin
  1475. vNode1.DownMove;
  1476. bSwap := True;
  1477. end;
  1478. end;
  1479. if bSwap = False then Break;
  1480. end;
  1481. if Assigned(ANode.FirstChild) then
  1482. BubbleSort(ANode.FirstChild);
  1483. if Assigned(ANode.NextSibling) then
  1484. BubbleSort(ANode.NextSibling);
  1485. end;
  1486. begin
  1487. BubbleSort(stdProjects.IDTree.FirstNode);
  1488. end;
  1489. end.