rmSelectProjectFrm.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757
  1. unit rmSelectProjectFrm;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, StdCtrls, sdGridDBA, sdGridTreeDBA, sdIDTree, ZJGrid;
  6. type
  7. // 初步设计 Preliminary Design
  8. // 施工图设计 Construction Drawing Design
  9. // 批准概算 Approved Budget
  10. // 多合同 Deal
  11. // 甘肃高管局定制 Mental1
  12. // 导则 造价台账汇总
  13. TMultiSelectType = (mstCommon, mstE_PCD, mstE_A, mstDeal, mstMental1, mstZjtz);
  14. // 所选项目
  15. TSelectProject = class
  16. private
  17. FProjectID: Integer;
  18. FIsTender: Boolean;
  19. FIsPD: Boolean;
  20. FIsCDD: Boolean;
  21. FIsAB: Boolean;
  22. FIsDeal: Boolean;
  23. FIsCddSc: Boolean;
  24. FIsCddHt: Boolean;
  25. public
  26. property ProjectID: Integer read FProjectID write FProjectID;
  27. property IsTender: Boolean read FIsTender write FIsTender;
  28. // 初步设计(概算)项目
  29. property IsPD: Boolean read FIsPD write FIsPD;
  30. // 施工图设计(预算)项目
  31. property IsCDD: Boolean read FIsCDD write FIsCDD;
  32. // 批准概算项目
  33. property IsAB: Boolean read FIsAB write FIsAB;
  34. // 多合同项目(二三部分,土地征拆、监理等)
  35. property IsDeal: Boolean read FIsDeal write FIsDeal;
  36. // 施工图设计审查预算
  37. property IsCddSc: Boolean read FIsCddSc write FIsCddSc;
  38. // 施工图设计合同费用
  39. property IsCddHt: Boolean read FIsCddHt write FIsCddHt;
  40. end;
  41. TProjectSelectForm = class(TForm)
  42. zgSelectProject: TZJGrid;
  43. stdSelectProject: TsdGridTreeDBA;
  44. btnOk: TButton;
  45. btnCancel: TButton;
  46. lblProjectList: TLabel;
  47. lblResult: TLabel;
  48. zgResult: TZJGrid;
  49. procedure zgSelectProjectCellTextChanged(Sender: TObject; Col,
  50. Row: Integer);
  51. procedure btnOkClick(Sender: TObject);
  52. procedure zgSelectProjectDrawCellText(ACanvas: TCanvas;
  53. const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
  54. const Text: String; var ADefaultDraw: Boolean);
  55. procedure zgSelectProjectCellTextChanging(Sender: TObject;
  56. const ACoord: TPoint; var NewValue: String; var Accept: Boolean);
  57. procedure zgSelectProjectSetCellText(Sender: TObject;
  58. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  59. procedure zgSelectProjectGetCellText(Sender: TObject;
  60. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  61. procedure zgResultGetCellText(Sender: TObject; const ACoord: TPoint;
  62. var Value: String; DisplayText: Boolean);
  63. procedure zgResultSetCellText(Sender: TObject; const ACoord: TPoint;
  64. var Value: String; DisplayText: Boolean);
  65. private
  66. FMultiSelect: Boolean;
  67. FMultiSelectType: TMultiSelectType;
  68. // 记录可选项目列表的勾选情况
  69. FSelectProjects: TList;
  70. FOnAssignResult: Boolean;
  71. procedure AssignResult;
  72. function FindSelectProject(AProjectID: Integer): TSelectProject;
  73. function CreateSelectProject(ANode: TsdIDTreeNode): TSelectProject;
  74. procedure AddRows(ANode: TsdIDTreeNode);
  75. procedure RemoveRows(ANode: TsdIDTreeNode);
  76. procedure SetPDProject(AProjecID: Integer);
  77. procedure SetCDDProject(AProjectID: Integer);
  78. procedure SetABProject(AProjectID: Integer);
  79. procedure SetCddScProject(AProjectID: Integer);
  80. procedure SetCddHtProject(AProjectID: Integer);
  81. function HasPDProject: Boolean;
  82. function HasCDDProject: Boolean;
  83. function HasABProject: Boolean;
  84. function HasCddScProject: Boolean;
  85. function HasCddHtProject: Boolean;
  86. procedure InitForm;
  87. procedure InitResultGrid;
  88. procedure SetMultiSelectType(const Value: TMultiSelectType);
  89. public
  90. constructor Create(AMultiSelect: Boolean; AProjectID: Integer; AProjects: TList);
  91. destructor Destroy; override;
  92. procedure SelectResult(var AProjectID: Integer); overload;
  93. procedure SelectResult(AProjects: TList); overload;
  94. // 可选多个
  95. property MultiSelect: Boolean read FMultiSelect;
  96. property MultiSelectType: TMultiSelectType read FMultiSelectType write SetMultiSelectType;
  97. end;
  98. implementation
  99. uses
  100. Globals, MainFrm, ZhAPI, ZjCells;
  101. {$R *.dfm}
  102. { TProjectSelectForm }
  103. procedure TProjectSelectForm.AssignResult;
  104. var
  105. iRow: Integer;
  106. stnNode: TsdIDTreeNode;
  107. i: Integer;
  108. SelectProject: TSelectProject;
  109. begin
  110. FOnAssignResult := True;
  111. zgSelectProject.Invalidate;
  112. InitResultGrid;
  113. for i := 0 to FSelectProjects.Count - 1 do
  114. begin
  115. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  116. if SelectProject.IsTender then
  117. begin
  118. zgResult.RowCount := zgResult.RowCount + 1;
  119. stnNode := stdSelectProject.IDTree.FindNode(SelectProject.ProjectID);
  120. zgResult.Cells[1, zgResult.RowCount - 1].Text :=
  121. stnNode.Rec.ValueByName('Name').AsString;
  122. zgResult.Cells[1, zgResult.RowCount - 1].Align := gaCenterLeft;
  123. zgResult.Rows[zgResult.RowCount - 1].Data := SelectProject;
  124. case FMultiSelectType of
  125. mstE_PCD:
  126. begin
  127. if SelectProject.IsPD then
  128. zgResult.Cells[2, zgResult.RowCount - 1].Text := 'True';
  129. if SelectProject.IsCDD then
  130. zgResult.Cells[3, zgResult.RowCount - 1].Text := 'True';
  131. end;
  132. mstE_A:
  133. begin
  134. if SelectProject.IsAB then
  135. zgResult.Cells[2, zgResult.RowCount - 1].Text := 'True';
  136. end;
  137. mstDeal:
  138. begin
  139. if SelectProject.IsDeal then
  140. zgResult.Cells[2, zgResult.RowCount - 1].Text := 'True';
  141. end;
  142. mstZjtz:
  143. begin
  144. if SelectProject.IsPD then
  145. zgResult.Cells[2, zgResult.RowCount - 1].Text := 'True';
  146. if SelectProject.IsCddSc then
  147. zgResult.Cells[3, zgResult.RowCount - 1].Text := 'True';
  148. if SelectProject.IsCddHt then
  149. zgResult.Cells[4, zgResult.RowCount - 1].Text := 'True';
  150. end;
  151. end;
  152. end;
  153. end;
  154. FOnAssignResult := False;
  155. end;
  156. procedure TProjectSelectForm.SelectResult(var AProjectID: Integer);
  157. var
  158. SelectProject: TSelectProject;
  159. begin
  160. AProjectID := -1;
  161. if FSelectProjects.Count > 0 then
  162. begin
  163. SelectProject := TSelectProject(FSelectProjects[0]);
  164. AProjectID := SelectProject.ProjectID;
  165. end;
  166. end;
  167. procedure TProjectSelectForm.zgSelectProjectCellTextChanged(
  168. Sender: TObject; Col, Row: Integer);
  169. begin
  170. if (Col = 1) then
  171. AssignResult;
  172. end;
  173. procedure TProjectSelectForm.btnOkClick(Sender: TObject);
  174. var
  175. iLimitProjectCount: Integer;
  176. begin
  177. iLimitProjectCount := 1;
  178. if FMultiSelect then
  179. begin
  180. if FMultiSelectType = mstE_PCD then
  181. iLimitProjectCount := 3
  182. else if FMultiSelectType = mstE_A then
  183. iLimitProjectCount := 2
  184. else if FMultiSelectType = mstZjtz then
  185. iLimitProjectCount := 4
  186. else
  187. iLimitProjectCount := 2;
  188. end;
  189. if (zgResult.RowCount > iLimitProjectCount) then
  190. begin
  191. if FMultiSelect then
  192. begin
  193. if (FMultiSelectType = mstE_PCD) and HasPDProject and HasCDDProject then
  194. ModalResult := mrOk
  195. else if (FMultiSelectType = mstE_A) and HasABProject then
  196. ModalResult := mrOk
  197. else if (FMultiSelectType = mstZjtz) and HasPDProject and HasCddScProject and HasCddHtProject then
  198. ModalResult := mrOk
  199. else if FMultiSelectType in [mstCommon, mstDeal, mstMental1] then
  200. ModalResult := mrOk;
  201. end
  202. else
  203. ModalResult := mrOK;
  204. end;
  205. end;
  206. constructor TProjectSelectForm.Create(AMultiSelect: Boolean;
  207. AProjectID: Integer; AProjects: TList);
  208. var
  209. stnNode: TsdIDTreeNode;
  210. begin
  211. inherited Create(nil);
  212. FMultiSelect := AMultiSelect;
  213. stdSelectProject.IDTree := ProjectManager.ProjectsTree;
  214. FSelectProjects := TList.Create;
  215. if not AMultiSelect then
  216. begin
  217. stnNode := stdSelectProject.IDTree.FindNode(AProjectID);
  218. AddRows(stnNode);
  219. end
  220. else
  221. FSelectProjects.Assign(AProjects);
  222. InitForm;
  223. AssignResult;
  224. end;
  225. procedure TProjectSelectForm.zgSelectProjectDrawCellText(ACanvas: TCanvas;
  226. const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
  227. const Text: String; var ADefaultDraw: Boolean);
  228. procedure GetBitmap(AImage: TBitmap);
  229. begin
  230. with stdSelectProject.IDTree.Items[ACoord.Y - 1] do
  231. if Rec.ValueByName('Type').AsInteger = 0 then
  232. if Expanded and HasChildren then
  233. MainForm.Images.GetBitmap(34, AImage)
  234. else
  235. MainForm.Images.GetBitmap(34, AImage)
  236. else
  237. MainForm.Images.GetBitmap(11, AImage);
  238. end;
  239. const
  240. rIconWidth = 16;
  241. rIconHeight = 16;
  242. var
  243. Img: TBitmap;
  244. Cell: TZjCell;
  245. rImg: TRect;
  246. begin
  247. if (ACoord.X = 2) and (ACoord.Y > zgSelectProject.FixedRowCount - 1) then
  248. begin
  249. Cell := zgSelectProject.Cells[ACoord.X, ACoord.Y];
  250. Img := TBitmap.Create;
  251. try
  252. GetBitmap(Img);
  253. case Cell.Align of
  254. gaTopLeft, gaTopCenter, gaTopRight:
  255. rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);
  256. gaCenterLeft, gaCenterCenter, gaCenterRight:
  257. 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);
  258. gaBottomLeft, gaBottomCenter, gaBottomRight:
  259. rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);
  260. end;
  261. ACanvas.StretchDraw(rImg, Img);
  262. WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)
  263. , 2, 2, Text, Cell.Align, False);
  264. ADefaultDraw := False;
  265. finally
  266. Img.Free;
  267. end;
  268. end;
  269. end;
  270. procedure TProjectSelectForm.zgSelectProjectCellTextChanging(
  271. Sender: TObject; const ACoord: TPoint; var NewValue: String;
  272. var Accept: Boolean);
  273. var
  274. stnNode: TsdIDTreeNode;
  275. begin
  276. if (ACoord.X = 1) then
  277. begin
  278. stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1];
  279. if not FMultiSelect then
  280. begin
  281. Accept := stnNode.Rec.ValueByName('Type').AsInteger = 1;
  282. if Accept then
  283. begin
  284. ClearObjects(FSelectProjects);
  285. FSelectProjects.Clear;
  286. end;
  287. end;
  288. end;
  289. end;
  290. procedure TProjectSelectForm.zgSelectProjectSetCellText(Sender: TObject;
  291. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  292. var
  293. stnNode: TsdIDTreeNode;
  294. begin
  295. if ACoord.X = 1 then
  296. begin
  297. stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1];
  298. if Value = 'True' then
  299. AddRows(stnNode)
  300. else
  301. RemoveRows(stnNode);
  302. end;
  303. end;
  304. procedure TProjectSelectForm.zgSelectProjectGetCellText(Sender: TObject;
  305. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  306. var
  307. stnNode: TsdIDTreeNode;
  308. SelectProject: TSelectProject;
  309. begin
  310. if ACoord.X = 1 then
  311. begin
  312. stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1];
  313. if Assigned(stnNode) then
  314. begin
  315. SelectProject := FindSelectProject(stnNode.ID);
  316. if Assigned(SelectProject) then
  317. Value := 'True';
  318. end;
  319. end;
  320. end;
  321. destructor TProjectSelectForm.Destroy;
  322. begin
  323. FSelectProjects.Free;
  324. inherited;
  325. end;
  326. procedure TProjectSelectForm.AddRows(ANode: TsdIDTreeNode);
  327. var
  328. iChild: Integer;
  329. SelectProject: TSelectProject;
  330. begin
  331. if not Assigned(ANode) then Exit;
  332. SelectProject := FindSelectProject(ANode.ID);
  333. if not Assigned(SelectProject) then
  334. CreateSelectProject(ANode);
  335. if ANode.HasChildren then
  336. for iChild := 0 to ANode.ChildCount - 1 do
  337. AddRows(ANode.ChildNodes[iChild]);
  338. end;
  339. procedure TProjectSelectForm.RemoveRows(ANode: TsdIDTreeNode);
  340. var
  341. iChild: Integer;
  342. SelectProject: TSelectProject;
  343. begin
  344. if not Assigned(ANode) then Exit;
  345. SelectProject := FindSelectProject(ANode.ID);
  346. if Assigned(SelectProject) then
  347. begin
  348. FSelectProjects.Remove(SelectProject);
  349. SelectProject.Free;
  350. end;
  351. if ANode.HasChildren then
  352. for iChild := 0 to ANode.ChildCount - 1 do
  353. RemoveRows(ANode.ChildNodes[iChild]);
  354. end;
  355. procedure TProjectSelectForm.SelectResult(AProjects: TList);
  356. begin
  357. AProjects.Assign(FSelectProjects);
  358. end;
  359. procedure TProjectSelectForm.InitResultGrid;
  360. procedure InitCommonResultGrid;
  361. begin
  362. zgResult.ColCount := 2;
  363. zgResult.RowCount := 1;
  364. zgResult.Cells[1, 0].Text := '所选项目';
  365. zgResult.ColWidths[1] := 270;
  366. end;
  367. procedure InitE_PCDResultGrid;
  368. begin
  369. zgResult.ColCount := 4;
  370. zgResult.RowCount := 1;
  371. zgResult.Cells[1, 0].Text := '所选项目';
  372. zgResult.ColWidths[1] := 200;
  373. zgResult.Cells[2, 0].Text := '初步设计概算';
  374. zgResult.CellClass.Cols[2] := TZjCheckBoxCell;
  375. zgResult.ColWidths[2] := 47;
  376. zgResult.Cells[3, 0].Text := '施工图设计预算';
  377. zgResult.CellClass.Cols[3] := TZjCheckBoxCell;
  378. zgResult.ColWidths[3] := 55;
  379. end;
  380. procedure InitE_AResultGrid;
  381. begin
  382. zgResult.ColCount := 3;
  383. zgResult.RowCount := 1;
  384. zgResult.Cells[1, 0].Text := '所选项目';
  385. zgResult.ColWidths[1] := 230;
  386. zgResult.Cells[2, 0].Text := '批准概(预)算';
  387. zgResult.CellClass.Cols[2] := TZjCheckBoxCell;
  388. zgResult.ColWidths[2] := 42;
  389. end;
  390. procedure InitDealResultGrid;
  391. begin
  392. zgResult.ColCount := 3;
  393. zgResult.RowCount := 1;
  394. zgResult.Cells[1, 0].Text := '所选项目';
  395. zgResult.ColWidths[1] := 230;
  396. zgResult.Cells[2, 0].Text := '多合同项目';
  397. zgResult.CellClass.Cols[2] := TZjCheckBoxCell;
  398. zgResult.ColWidths[2] := 42;
  399. end;
  400. procedure InitZjtzResultGrid;
  401. begin
  402. zgResult.ColCount := 5;
  403. zgResult.RowCount := 1;
  404. zgResult.Cells[1, 0].Text := '所选项目';
  405. zgResult.ColWidths[1] := 200;
  406. zgResult.Cells[2, 0].Text := '初步设计概算';
  407. zgResult.CellClass.Cols[2] := TZjCheckBoxCell;
  408. zgResult.ColWidths[2] := 47;
  409. zgResult.Cells[3, 0].Text := '施工图设计审查预算';
  410. zgResult.CellClass.Cols[3] := TZjCheckBoxCell;
  411. zgResult.ColWidths[3] := 60;
  412. zgResult.Cells[4, 0].Text := '施工图设计合同费用';
  413. zgResult.CellClass.Cols[4] := TZjCheckBoxCell;
  414. zgResult.ColWidths[4] := 60;
  415. end;
  416. begin
  417. case FMultiSelectType of
  418. mstCommon: InitCommonResultGrid;
  419. mstE_PCD: InitE_PCDResultGrid;
  420. mstE_A: InitE_AResultGrid;
  421. mstDeal: InitDealResultGrid;
  422. mstZjtz: InitZjtzResultGrid;
  423. end;
  424. end;
  425. procedure TProjectSelectForm.zgResultGetCellText(Sender: TObject;
  426. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  427. var
  428. SelectProject: TSelectProject;
  429. begin
  430. if (ACoord.Y > 0) and (ACoord.X > 1) then
  431. begin
  432. SelectProject := TSelectProject(zgResult.Rows[ACoord.Y].Data);
  433. if not Assigned(SelectProject) then Exit;
  434. case FMultiSelectType of
  435. mstE_PCD: if ((ACoord.X = 2) and SelectProject.IsPD) or ((ACoord.X = 3) and SelectProject.IsCDD) then Value := 'True'
  436. else Value := 'False';
  437. mstE_A: if SelectProject.IsAB then Value := 'True'
  438. else Value := 'False';
  439. mstDeal: if SelectProject.IsDeal then Value := 'True'
  440. else Value := 'False';
  441. mstZjtz: if ((ACoord.X = 2) and SelectProject.IsPD) or
  442. ((ACoord.X = 3) and SelectProject.IsCddSc) or
  443. ((ACoord.X = 4) and SelectProject.IsCddHt)
  444. then Value := 'True'
  445. else Value := 'False';
  446. end;
  447. end;
  448. end;
  449. procedure TProjectSelectForm.zgResultSetCellText(Sender: TObject;
  450. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  451. var
  452. SelectProject: TSelectProject;
  453. begin
  454. if not FOnAssignResult and (ACoord.X > 1) and (ACoord.Y > 0) then
  455. begin
  456. SelectProject := TSelectProject(zgResult.Rows[ACoord.Y].Data);
  457. if Value = 'True' then
  458. case FMultiSelectType of
  459. mstE_PCD:
  460. if ACoord.X = 2 then
  461. SetPDProject(SelectProject.ProjectID)
  462. else if ACoord.X = 3 then
  463. SetCDDProject(SelectProject.ProjectID);
  464. mstE_A: SetABProject(SelectProject.ProjectID);
  465. mstDeal: SelectProject.IsDeal := True;
  466. mstZjtz:
  467. if ACoord.X = 2 then
  468. SetPDProject(SelectProject.ProjectID)
  469. else if ACoord.X = 3 then
  470. SetCddScProject(SelectProject.ProjectID)
  471. else if ACoord.X = 4 then
  472. SetCddHtProject(SelectProject.ProjectID);
  473. end
  474. else
  475. case FMultiSelectType of
  476. mstE_PCD:
  477. if ACoord.X = 2 then
  478. SelectProject.IsPD := False
  479. else
  480. SelectProject.IsCDD := False;
  481. mstE_A: SelectProject.IsAB := False;
  482. mstDeal: SelectProject.IsDeal := False;
  483. mstZjtz:
  484. if ACoord.X = 2 then
  485. SelectProject.IsPD := False
  486. else if ACoord.X = 3 then
  487. SelectProject.IsCddSc := False
  488. else if ACoord.X = 4 then
  489. SelectProject.IsCddHt := False;
  490. end;
  491. end;
  492. zgResult.InvalidateCol(ACoord.X);
  493. zgResult.InvalidateRow(ACoord.Y);
  494. end;
  495. procedure TProjectSelectForm.InitForm;
  496. var
  497. iWidth: Integer;
  498. begin
  499. if not FMultiSelect then
  500. Caption := '请选择原报项目'
  501. else
  502. Caption := '请选择汇总项目';
  503. case FMultiSelectType of
  504. mstE_PCD: Caption := Caption + ',并勾选初步设计、施工图设计项目';
  505. mstE_A: Caption := Caption + ',并勾选批准概(预)算项目';
  506. mstDeal: Caption := Caption + ',并勾选其中的多合同项目';
  507. mstZjtz: Caption := Caption + ',并勾选初步设计、施工图设计审查预算、施工图设计合同费用项目';
  508. end;
  509. // 甘肃高管局定制,隐藏结果表
  510. iWidth := GetSystemMetrics(SM_CXFRAME);
  511. if FMultiSelectType = mstMental1 then
  512. ClientWidth := 384
  513. else if FMultiSelectType = mstZjtz then
  514. ClientWidth := 809
  515. else
  516. ClientWidth := 729;
  517. end;
  518. procedure TProjectSelectForm.SetMultiSelectType(
  519. const Value: TMultiSelectType);
  520. begin
  521. FMultiSelectType := Value;
  522. InitForm;
  523. AssignResult;
  524. end;
  525. function TProjectSelectForm.FindSelectProject(
  526. AProjectID: Integer): TSelectProject;
  527. var
  528. i: Integer;
  529. SelectProject: TSelectProject;
  530. begin
  531. Result := nil;
  532. for i := 0 to FSelectProjects.Count - 1 do
  533. begin
  534. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  535. if SelectProject.FProjectID = AProjectID then
  536. begin
  537. Result := SelectProject;
  538. Break;
  539. end;
  540. end;
  541. end;
  542. function TProjectSelectForm.CreateSelectProject(
  543. ANode: TsdIDTreeNode): TSelectProject;
  544. begin
  545. Result := TSelectProject.Create;
  546. FSelectProjects.Add(Result);
  547. Result.ProjectID := ANode.ID;
  548. Result.FIsTender := ANode.Rec.ValueByName('Type').AsInteger = 1;
  549. Result.FIsPD := False;
  550. Result.FIsCDD := False;
  551. Result.FIsAB := False;
  552. Result.FIsDeal := False;
  553. end;
  554. procedure TProjectSelectForm.SetPDProject(AProjecID: Integer);
  555. var
  556. i: Integer;
  557. SelectProject: TSelectProject;
  558. begin
  559. for i := 0 to FSelectProjects.Count - 1 do
  560. begin
  561. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  562. SelectProject.IsPD := SelectProject.ProjectID = AProjecID;
  563. if SelectProject.IsPD and SelectProject.IsCDD then
  564. SelectProject.IsCDD := False;
  565. end;
  566. end;
  567. procedure TProjectSelectForm.SetABProject(AProjectID: Integer);
  568. var
  569. i: Integer;
  570. SelectProject: TSelectProject;
  571. begin
  572. for i := 0 to FSelectProjects.Count - 1 do
  573. begin
  574. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  575. SelectProject.IsAB := SelectProject.ProjectID = AProjectID;
  576. end;
  577. end;
  578. procedure TProjectSelectForm.SetCDDProject(AProjectID: Integer);
  579. var
  580. i: Integer;
  581. SelectProject: TSelectProject;
  582. begin
  583. for i := 0 to FSelectProjects.Count - 1 do
  584. begin
  585. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  586. SelectProject.IsCDD := SelectProject.ProjectID = AProjectID;
  587. if SelectProject.IsCDD and SelectProject.IsPD then
  588. SelectProject.IsPD := False;
  589. end;
  590. end;
  591. function TProjectSelectForm.HasABProject: Boolean;
  592. var
  593. i: Integer;
  594. SelectProject: TSelectProject;
  595. begin
  596. Result := False;
  597. for i := 0 to FSelectProjects.Count - 1 do
  598. begin
  599. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  600. if SelectProject.IsAB then
  601. begin
  602. Result := True;
  603. Break;
  604. end;
  605. end;
  606. end;
  607. function TProjectSelectForm.HasCDDProject: Boolean;
  608. var
  609. i: Integer;
  610. SelectProject: TSelectProject;
  611. begin
  612. Result := False;
  613. for i := 0 to FSelectProjects.Count - 1 do
  614. begin
  615. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  616. if SelectProject.IsCDD then
  617. begin
  618. Result := True;
  619. Break;
  620. end;
  621. end;
  622. end;
  623. function TProjectSelectForm.HasPDProject: Boolean;
  624. var
  625. i: Integer;
  626. SelectProject: TSelectProject;
  627. begin
  628. Result := False;
  629. for i := 0 to FSelectProjects.Count - 1 do
  630. begin
  631. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  632. if SelectProject.IsPD then
  633. begin
  634. Result := True;
  635. Break;
  636. end;
  637. end;
  638. end;
  639. function TProjectSelectForm.HasCddHtProject: Boolean;
  640. var
  641. i: Integer;
  642. SelectProject: TSelectProject;
  643. begin
  644. Result := False;
  645. for i := 0 to FSelectProjects.Count - 1 do
  646. begin
  647. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  648. if SelectProject.IsCddHt then
  649. begin
  650. Result := True;
  651. Break;
  652. end;
  653. end;
  654. end;
  655. function TProjectSelectForm.HasCddScProject: Boolean;
  656. var
  657. i: Integer;
  658. SelectProject: TSelectProject;
  659. begin
  660. Result := False;
  661. for i := 0 to FSelectProjects.Count - 1 do
  662. begin
  663. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  664. if SelectProject.IsCddSc then
  665. begin
  666. Result := True;
  667. Break;
  668. end;
  669. end;
  670. end;
  671. procedure TProjectSelectForm.SetCddHtProject(AProjectID: Integer);
  672. var
  673. i: Integer;
  674. SelectProject: TSelectProject;
  675. begin
  676. for i := 0 to FSelectProjects.Count - 1 do
  677. begin
  678. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  679. SelectProject.IsCddHt := SelectProject.ProjectID = AProjectID;
  680. end;
  681. end;
  682. procedure TProjectSelectForm.SetCddScProject(AProjectID: Integer);
  683. var
  684. i: Integer;
  685. SelectProject: TSelectProject;
  686. begin
  687. for i := 0 to FSelectProjects.Count - 1 do
  688. begin
  689. SelectProject := TSelectProject(FSelectProjects.Items[i]);
  690. SelectProject.IsCddSc := SelectProject.ProjectID = AProjectID;
  691. end;
  692. end;
  693. end.