CheckerFme.pas 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366
  1. {*******************************************************************************
  2. 单元名称: CheckerFme.pas
  3. 单元说明: 审核人窗口。
  4. 作者时间: Chenshilong, 2014-07-11
  5. *******************************************************************************}
  6. unit CheckerFme;
  7. interface
  8. uses
  9. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10. Dialogs, ExtCtrls, StdCtrls, OrderCheckerFme, JimLabels, Contnrs, Checker;
  11. type
  12. TCheckerFrame = class(TFrame)
  13. pnlProject: TPanel;
  14. sbChecker: TScrollBox;
  15. pnlTitle: TPanel;
  16. labTitle: TJimGradLabel;
  17. tRefreshCheckers: TTimer;
  18. procedure tRefreshCheckersTimer(Sender: TObject);
  19. private
  20. FProjectData: TObject;
  21. FCount: Integer;
  22. FOwner: TObject;
  23. FOwnerFrame: TOrderCheckerFrame;
  24. FAddFrame: TOrderCheckerFrame;
  25. FList: TObjectList; // Add窗也进FList
  26. FCurPos: Integer;
  27. procedure SetProjectData(const Value: TObject);
  28. procedure SetOwner(const Value: TObject);
  29. { Private declarations }
  30. public
  31. { Public declarations }
  32. property ProjectData: TObject read FProjectData write SetProjectData;
  33. property Owner: TObject read FOwner write SetOwner;
  34. property OwnerFrame: TOrderCheckerFrame read FOwnerFrame write FOwnerFrame; // 这个特指终审人的Frame
  35. property AddFrame: TOrderCheckerFrame read FAddFrame write FAddFrame; // 这个特指新增人的Frame
  36. property List: TObjectList read FList;
  37. property CurPos: Integer read FCurPos write FCurPos;
  38. constructor Create(AOwner: TComponent); override;
  39. destructor Destroy; override;
  40. procedure Init;
  41. // 审核人的名字、职位、公司、图像
  42. procedure AddNewChecker(AType: TCheckerFrameType; AID: Integer; AName,
  43. ARole, ACompany, AImagePath, ACheckerMemo: string; ACheckStatus: TCheckStatus);
  44. function InCheckerList(ACheckerID: Integer): Boolean;
  45. function HasNormalChecker: Boolean; // 有普通审核人就返回True(光有业主不算)
  46. function HasChecker: Boolean; // 列表不为空即返回True(光Add也算)
  47. procedure CheckerNameList(var ASL: TStringList);
  48. procedure RepairOrder;
  49. procedure RepairDelete(ACanDelete: Boolean);
  50. function FirstChecker: TOrderCheckerFrame;
  51. function NextChecker: TOrderCheckerFrame;
  52. function LastChecker: TOrderCheckerFrame;
  53. function Me: TOrderCheckerFrame;
  54. function CheckNo(ACheckStatus: TCheckStatus): Integer; // 返回指定的审核状态是列表中的第几个人
  55. end;
  56. implementation
  57. uses FindUserFrm, PHPWebDm, ProjectData, CslJson, ConstUnit, ProjectFme;
  58. {$R *.dfm}
  59. procedure TCheckerFrame.AddNewChecker(AType: TCheckerFrameType; AID: Integer;
  60. AName, ARole, ACompany, AImagePath, ACheckerMemo: string; ACheckStatus: TCheckStatus);
  61. var vChecker: TOrderCheckerFrame;
  62. begin
  63. vChecker := TOrderCheckerFrame.Create(Self);
  64. vChecker.Owner := Self;
  65. vChecker.Init(AType, AID, AName, ARole, ACompany, AImagePath, ACheckerMemo, ACheckStatus);
  66. sbChecker.Height := sbChecker.Height + vChecker.Height;
  67. vChecker.Parent := sbChecker;
  68. vChecker.Top := FCurPos;
  69. FCurPos := FCurPos + vChecker.Height;
  70. vChecker.Align := alTop;
  71. // 调整位置
  72. case AType of
  73. cftChecker:
  74. begin
  75. vChecker.Name := 'OrderFrame' + IntToStr(AID);
  76. if Assigned(AddFrame) then // 适用于查找审核人添加数据库后,插入Add窗之前
  77. begin
  78. vChecker.Top := AddFrame.Top;
  79. AddFrame.Top := vChecker.Top + vChecker.Height;
  80. OwnerFrame.Top := AddFrame.Top + AddFrame.Height;
  81. FList.Insert(FList.Indexof(AddFrame), vChecker);
  82. end
  83. else
  84. FList.Add(vChecker);
  85. end;
  86. cftOwner: // 保险,保证终审窗一定在Add窗之后
  87. begin
  88. OwnerFrame := vChecker;
  89. vChecker.Name := 'OwnerFrame';
  90. if Assigned(AddFrame) then
  91. OwnerFrame.Top := AddFrame.Top + AddFrame.Height;
  92. FList.Add(vChecker);
  93. end;
  94. cftAdd: // Add窗插入到终审窗之前
  95. begin
  96. AddFrame := vChecker;
  97. vChecker.Name := 'AddFrame';
  98. if Assigned(OwnerFrame) then
  99. begin
  100. AddFrame.Top := OwnerFrame.Top;
  101. OwnerFrame.Top := AddFrame.Top + AddFrame.Height;
  102. FList.Insert(FList.Indexof(OwnerFrame), vChecker);
  103. end
  104. else
  105. FList.Add(vChecker);
  106. end;
  107. end;
  108. end;
  109. procedure TCheckerFrame.Init;
  110. var
  111. i: Integer;
  112. vA: TOVArr;
  113. sURL, sPicPath, sID, sErrors: string;
  114. vProj: TProjectData;
  115. bOwner, bOwnerFinish: Boolean;
  116. vStatus: TCheckStatus;
  117. vCM: TChecker;
  118. begin
  119. FList.Clear;
  120. OwnerFrame := nil;
  121. AddFrame := nil;
  122. sbChecker.Height := 0;
  123. FCurPos := 0;
  124. vProj := TProjectData(FProjectData);
  125. vProj.Checkers.Clear;
  126. // 这里,这里搞死爹...编制人第一期上报后,关掉项目,重新打开这个项目,第一次,
  127. // 我说的是第一次——一定读取不了审核人列表,但第二次、以后每次都正常。你知道
  128. // 读取不了这个列表的后果有多严重吗?网络版的每个角落都依赖于审核人的角色,所
  129. // 以后果就是直接崩溃,无法使用。查明原因:服务器那头的PHP第一次接收不了传上
  130. // 去的数据,日志显示读取到的数组为空。
  131. // 所以这里把参数移到URL中,通过URL的方式传递,避开用数组传递,问题解决。
  132. // 很明显,这种方式的局限性很大,只适合参数较少的情况。该问题已被珠海纵横公司
  133. // 计量支付网络版研发团队定性为PHP业界的灵异事件。如果哪天你用科学解释了它,请
  134. // 一定要告诉我个中缘由。chenshilong, 2014-07-21
  135. sURL := Format('%suser/get/all/%d/%d/measure', [PHPWeb.MeasureURL, vProj.WebID, vProj.PhaseIndex]);
  136. if PHPWeb.Search(sURL, [''], [''], vA) = 1 then
  137. begin
  138. for i := Low(vA) to High(vA) do
  139. begin
  140. sID := vA[i, 4];
  141. sPicPath := PHPWeb.UserPath + '1_' + sID + '.jpg';
  142. PHPWeb.DownFile(vA[i, 5], sPicPath);
  143. vStatus := TCheckStatus(StrToInt(vA[i, 3])-1); // Json返回1、2、3、4
  144. bOwner := StrToInt(sID) = TProjectData(ProjectData).WebOwnerID;
  145. if bOwner then // 添加业主
  146. begin
  147. if TProjectData(ProjectData).CurUserIsAuthor then
  148. begin
  149. {如果是编制人,添加业主前先添加Add框。
  150. 数据库中,编制人没有审核人这样的状态。只有跟随标段的两种状态:
  151. ①有标段(顺便记录了编制人,标段是编制人创建的) ②没有标段。
  152. 为什么不通过是否有标段来判断当前是否显示“添加新的审核人”呢?
  153. 因为无法得知当前项目是数据库中已存在的最新一期还是仅存于本地尚末入库
  154. 的最新一期。改由添加的位置给出提示}
  155. if (TProjectData(ProjectData).PhaseIndex > 0) and (not TProjectFrame(Owner).IsUped) then
  156. AddNewChecker(cftAdd, -1, '', '', '', '', '', csNotBegin);
  157. end;
  158. AddNewChecker(cftOwner, StrToInt(sID),
  159. vA[i, 0], vA[i, 2], vA[i, 1], sPicPath, vA[i, 6], vStatus);
  160. end
  161. else
  162. AddNewChecker(cftChecker, StrToInt(vA[i, 4]),
  163. vA[i, 0], vA[i, 2], vA[i, 1], sPicPath, vA[i, 6], vStatus);
  164. vCM := TChecker.Create;
  165. vProj.Checkers.Add(StrToInt(vA[i, 4]), vA[i, 0], vA[i, 2], vA[i, 6]);
  166. end;
  167. RepairOrder;
  168. end
  169. else
  170. begin
  171. sErrors := Format('无法读取审核人列表,这将会导致桌面程序崩溃!%s地址:%s%s标段ID:%s,期号:%s',
  172. [#13#10#13#10, sURL, #13#10#13#10, IntToStr(vProj.WebID), IntToStr(vProj.PhaseIndex)]);
  173. Application.MessageBox(PChar(sErrors), '错误', MB_OK + MB_ICONERROR);
  174. Application.Terminate;
  175. end;
  176. end;
  177. procedure TCheckerFrame.SetProjectData(const Value: TObject);
  178. begin
  179. FProjectData := Value;
  180. end;
  181. function TCheckerFrame.InCheckerList(ACheckerID: Integer): Boolean;
  182. var i: Integer;
  183. begin
  184. Result := False;
  185. for i := 0 to FList.Count - 1 do
  186. begin
  187. if TOrderCheckerFrame(FList[i]).UserID = ACheckerID then
  188. begin
  189. Result := True;
  190. Break;
  191. end;
  192. end;
  193. end;
  194. procedure TCheckerFrame.CheckerNameList(var ASL: TStringList);
  195. var i: Integer;
  196. vFrame: TOrderCheckerFrame;
  197. begin
  198. ASL.Clear;
  199. for i := 0 to FList.Count - 1 do
  200. begin
  201. vFrame := TOrderCheckerFrame(FList[i]);
  202. if vFrame.CheckerFrameType <> cftAdd then
  203. ASL.Add(Format('%s', [vFrame.UserName]));
  204. end;
  205. end;
  206. procedure TCheckerFrame.SetOwner(const Value: TObject);
  207. begin
  208. FOwner := Value;
  209. end;
  210. procedure TCheckerFrame.RepairOrder;
  211. var i: Integer;
  212. begin
  213. for i := 0 to FList.Count - 1 do
  214. TOrderCheckerFrame(FList[i]).Order := i + 1;
  215. end;
  216. function TCheckerFrame.HasNormalChecker: Boolean;
  217. var i: Integer;
  218. begin
  219. Result := False;
  220. for i := 0 to FList.Count - 1 do
  221. begin
  222. if TOrderCheckerFrame(FList[i]).CheckerFrameType = cftChecker then
  223. begin
  224. Result := True;
  225. Break;
  226. end;
  227. end;
  228. end;
  229. constructor TCheckerFrame.Create(AOwner: TComponent);
  230. begin
  231. inherited;
  232. FList := TObjectList.Create;
  233. end;
  234. destructor TCheckerFrame.Destroy;
  235. begin
  236. FList.Free;
  237. inherited;
  238. end;
  239. function TCheckerFrame.FirstChecker: TOrderCheckerFrame;
  240. begin
  241. Result := nil;
  242. if FList.Count > 0 then
  243. begin
  244. if TOrderCheckerFrame(FList[0]).CheckerFrameType <> cftAdd then
  245. Result := TOrderCheckerFrame(FList[0])
  246. else
  247. Result := TOrderCheckerFrame(FList[1]);
  248. end;
  249. end;
  250. function TCheckerFrame.NextChecker: TOrderCheckerFrame;
  251. var i: Integer;
  252. vFrame: TOrderCheckerFrame;
  253. begin
  254. Result := nil;
  255. if FList.Count = 0 then Exit;
  256. for i := 0 to FList.Count - 1 do
  257. begin
  258. if (TOrderCheckerFrame(FList[i]).UserID = PHPWeb.UserID) then
  259. begin
  260. if i = (FList.Count - 1) then Exit; // 最后一个
  261. Result := TOrderCheckerFrame(FList[i + 1]);
  262. if Result.CheckerFrameType = cftAdd then
  263. Result := TOrderCheckerFrame(FList[i + 2]);
  264. Break;
  265. end;
  266. end;
  267. end;
  268. function TCheckerFrame.Me: TOrderCheckerFrame;
  269. var i: Integer;
  270. begin
  271. Result := nil;
  272. for i := 0 to FList.Count - 1 do
  273. begin
  274. if TOrderCheckerFrame(FList[i]).UserID = PHPWeb.UserID then
  275. begin
  276. Result := TOrderCheckerFrame(FList[i]);
  277. Break;
  278. end;
  279. end;
  280. end;
  281. procedure TCheckerFrame.RepairDelete(ACanDelete: Boolean);
  282. var i: Integer;
  283. begin
  284. for i := 0 to FList.Count - 1 do
  285. begin
  286. if (TOrderCheckerFrame(FList[i]) <> OwnerFrame) and
  287. (TOrderCheckerFrame(FList[i]) <> AddFrame) then
  288. TOrderCheckerFrame(FList[i]).btnDelete.Visible := ACanDelete;
  289. end;
  290. end;
  291. procedure TCheckerFrame.tRefreshCheckersTimer(Sender: TObject);
  292. begin
  293. tRefreshCheckers.Enabled := False;
  294. try
  295. init;
  296. RepairDelete(True);
  297. except
  298. ShowMessage('删除成功,这里做了异常保护');
  299. end;
  300. end;
  301. function TCheckerFrame.HasChecker: Boolean;
  302. begin
  303. Result := (FList.Count > 0);
  304. end;
  305. function TCheckerFrame.CheckNo(ACheckStatus: TCheckStatus): Integer;
  306. var i, iCount: Integer;
  307. begin
  308. Result := -1;
  309. for i := 0 to FList.Count - 1 do
  310. begin
  311. if TOrderCheckerFrame(FList[i]).CheckStatus = ACheckStatus then
  312. begin
  313. Result := i + 1;
  314. Break;
  315. end;
  316. end;
  317. end;
  318. function TCheckerFrame.LastChecker: TOrderCheckerFrame;
  319. var i: Integer;
  320. begin
  321. Result := FOwnerFrame;
  322. end;
  323. end.