ProjectManagerFme.pas 52 KB

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