ProjGatherSelectFrm.pas 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419
  1. unit ProjGatherSelectFrm;
  2. interface
  3. uses
  4. sdIDTree, sdDB,
  5. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  6. Dialogs, sdGridDBA, sdGridTreeDBA, StdCtrls, ZJGrid, ZJCells;
  7. type
  8. TProjGatherSelectForm = class(TForm)
  9. lblProjectList: TLabel;
  10. lblResult: TLabel;
  11. zgSelectProject: TZJGrid;
  12. zgResult: TZJGrid;
  13. btnOk: TButton;
  14. btnCancel: TButton;
  15. stdSelectProject: TsdGridTreeDBA;
  16. procedure zgSelectProjectGetCellText(Sender: TObject;
  17. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  18. procedure zgSelectProjectSetCellText(Sender: TObject;
  19. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  20. procedure zgSelectProjectCellTextChanged(Sender: TObject; Col,
  21. Row: Integer);
  22. procedure btnOkClick(Sender: TObject);
  23. procedure zgSelectProjectDrawCellText(ACanvas: TCanvas;
  24. const ARect: TRect; const ACoord: TPoint; AGrid: TZJGrid;
  25. const Text: String; var ADefaultDraw: Boolean);
  26. procedure zgResultGetCellText(Sender: TObject; const ACoord: TPoint;
  27. var Value: String; DisplayText: Boolean);
  28. procedure zgResultSetCellText(Sender: TObject; const ACoord: TPoint;
  29. var Value: String; DisplayText: Boolean);
  30. private
  31. FProjectID: Integer;
  32. FValidProjs: TList;
  33. FSelectProjs: TList;
  34. FSpecialProjTypes: TStrings;
  35. FSpecialProjIDs: array of Integer;
  36. function HasSelect(AProjectID: Integer): Boolean;
  37. procedure AddProjs(ANode: TsdIDTreeNode);
  38. procedure RemoveProjs(ANode: TsdIDTreeNode);
  39. procedure AssignSelectTenders;
  40. function GetTopParent: TsdIDTreeNode;
  41. procedure AddValidProject(ANode: TsdIDTreeNode);
  42. procedure FilterValidProject;
  43. function IsValidProj(AID: Integer): Boolean;
  44. procedure DoOnFilterRecord(ARecord: TsdDataRecord; var AAllow: Boolean);
  45. procedure LoadHistorySelects(AProjs: TList);
  46. public
  47. constructor Create(AProjectID: Integer; AProjs: TList; ASpecialProjTypes: TStrings);
  48. destructor Destroy; override;
  49. procedure AssignResult(AProjs: TList);
  50. end;
  51. function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
  52. implementation
  53. uses
  54. Globals, GatherProjInfo, MainFrm, Math, ZhAPI;
  55. {$R *.dfm}
  56. function SelectGatherProject(AProjectID: Integer; AOrgProjs, ANewProjs: TList; ASpecialProjTypes: TStrings = nil): Boolean;
  57. var
  58. vSelectFrm: TProjGatherSelectForm;
  59. begin
  60. vSelectFrm := TProjGatherSelectForm.Create(AProjectID, AOrgProjs, ASpecialProjTypes);
  61. try
  62. Result := vSelectFrm.ShowModal = mrOk;
  63. if Result then
  64. vSelectFrm.AssignResult(ANewProjs);
  65. finally
  66. vSelectFrm.Free;
  67. end;
  68. end;
  69. { TProjGatherSelectForm }
  70. procedure TProjGatherSelectForm.AddProjs(ANode: TsdIDTreeNode);
  71. var
  72. iChild: Integer;
  73. begin
  74. if FSelectProjs.IndexOf(Pointer(ANode.ID)) = -1 then
  75. FSelectProjs.Add(Pointer(ANode.id));
  76. for iChild := 0 to ANode.ChildCount - 1 do
  77. AddProjs(ANode.ChildNodes[iChild]);
  78. end;
  79. procedure TProjGatherSelectForm.AddValidProject(ANode: TsdIDTreeNode);
  80. var
  81. iChild: Integer;
  82. begin
  83. FValidProjs.Add(ANode);
  84. for iChild := 0 to ANode.ChildCount - 1 do
  85. AddValidProject(ANode.ChildNodes[iChild]);
  86. end;
  87. constructor TProjGatherSelectForm.Create(AProjectID: Integer;
  88. AProjs: TList; ASpecialProjTypes: TStrings);
  89. var
  90. i: Integer;
  91. begin
  92. inherited Create(nil);
  93. ClientHeight := 523;
  94. ClientWidth := 750;
  95. FProjectID := AProjectID;
  96. FSpecialProjTypes := ASpecialProjTypes;
  97. if FSpecialProjTypes <> nil then
  98. begin
  99. SetLength(FSpecialProjIDs, FSpecialProjTypes.Count);
  100. for i := 0 to ASpecialProjTypes.Count - 1 do
  101. FSpecialProjIDs[i] := -1;
  102. end;
  103. FValidProjs := TList.Create;
  104. FilterValidProject;
  105. ProjectManager.sdvProjectsSpare.OnFilterRecord := DoOnFilterRecord;
  106. ProjectManager.sdvProjectsSpare.Filtered := True;
  107. stdSelectProject.DataView := ProjectManager.sdvProjectsSpare;
  108. FSelectProjs := TList.Create;
  109. LoadHistorySelects(AProjs);
  110. AssignSelectTenders;
  111. end;
  112. destructor TProjGatherSelectForm.Destroy;
  113. begin
  114. ProjectManager.sdvProjectsSpare.Filtered := False;
  115. ProjectManager.sdvProjectsSpare.OnFilterRecord := nil;
  116. FValidProjs.Free;
  117. FSelectProjs.Free;
  118. inherited;
  119. end;
  120. procedure TProjGatherSelectForm.DoOnFilterRecord(ARecord: TsdDataRecord;
  121. var AAllow: Boolean);
  122. begin
  123. AAllow := Assigned(ARecord) and IsValidProj(ARecord.ValueByName('ID').AsInteger);
  124. end;
  125. procedure TProjGatherSelectForm.FilterValidProject;
  126. var
  127. vTopParent: TsdIDTreeNode;
  128. i: Integer;
  129. begin
  130. vTopParent := GetTopParent;
  131. AddValidProject(vTopParent);
  132. end;
  133. function TProjGatherSelectForm.GetTopParent: TsdIDTreeNode;
  134. begin
  135. Result := ProjectManager.ProjectsTree.FindNode(FProjectID);
  136. while Assigned(Result.Parent) do
  137. Result := Result.Parent;
  138. end;
  139. function TProjGatherSelectForm.HasSelect(AProjectID: Integer): Boolean;
  140. begin
  141. Result := FSelectProjs.IndexOf(Pointer(AProjectID)) <> -1;
  142. end;
  143. function TProjGatherSelectForm.IsValidProj(AID: Integer): Boolean;
  144. var
  145. i: Integer;
  146. vNode: TsdIDTreeNode;
  147. begin
  148. Result := False;
  149. for i := 0 to FValidProjs.Count - 1 do
  150. begin
  151. vNode := TsdIDTreeNode(FValidProjs.Items[i]);
  152. if vNode.ID = AID then
  153. begin
  154. Result := True;
  155. Break;
  156. end;
  157. end;
  158. end;
  159. procedure TProjGatherSelectForm.RemoveProjs(ANode: TsdIDTreeNode);
  160. var
  161. iChild: Integer;
  162. i: Integer;
  163. begin
  164. if FSelectProjs.IndexOf(Pointer(ANode.ID)) <> -1 then
  165. begin
  166. FSelectProjs.Remove(Pointer(ANode.id));
  167. for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
  168. if FSpecialProjIDs[i] = ANode.ID then
  169. FSpecialProjIDs[i] := -1;
  170. end;
  171. for iChild := 0 to ANode.ChildCount - 1 do
  172. RemoveProjs(ANode.ChildNodes[iChild]);
  173. end;
  174. procedure TProjGatherSelectForm.zgSelectProjectGetCellText(Sender: TObject;
  175. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  176. var
  177. stnNode: TsdIDTreeNode;
  178. begin
  179. if ACoord.X = 1 then
  180. begin
  181. stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1];
  182. if Assigned(stnNode) and HasSelect(stnNode.ID) then
  183. Value := 'True';
  184. end;
  185. end;
  186. procedure TProjGatherSelectForm.zgSelectProjectSetCellText(Sender: TObject;
  187. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  188. var
  189. stnNode: TsdIDTreeNode;
  190. begin
  191. if ACoord.X = 1 then
  192. begin
  193. stnNode := stdSelectProject.IDTree.Items[ACoord.Y - 1];
  194. if Value = 'True' then
  195. AddProjs(stnNode)
  196. else
  197. RemoveProjs(stnNode);
  198. end;
  199. zgSelectProject.InvalidateCol(1);
  200. end;
  201. procedure TProjGatherSelectForm.zgSelectProjectCellTextChanged(
  202. Sender: TObject; Col, Row: Integer);
  203. begin
  204. if (Col = 1) then
  205. AssignSelectTenders;
  206. end;
  207. procedure TProjGatherSelectForm.AssignSelectTenders;
  208. procedure InitResultGrid;
  209. var
  210. i: Integer;
  211. begin
  212. zgResult.ColCount := 2;
  213. zgResult.RowCount := 1;
  214. zgResult.Cells[1, 0].Text := 'ËùÑ¡ÏîÄ¿';
  215. zgResult.ColWidths[1] := 308;
  216. if Assigned(FSpecialProjTypes) then
  217. begin
  218. zgResult.ColWidths[1] := 308 - (Min(FSpecialProjTypes.Count, 2)*45);
  219. for i := 0 to FSpecialProjTypes.Count - 1 do
  220. begin
  221. zgResult.ColCount := zgResult.ColCount + 1;
  222. zgResult.Cells[2+i, 0].Text := FSpecialProjTypes.Strings[i];
  223. zgResult.ColWidths[2+i] := 45;
  224. zgResult.CellClass.Cols[2+i] := TZjCheckBoxCell;
  225. end;
  226. end;
  227. end;
  228. var
  229. stnNode: TsdIDTreeNode;
  230. i, iProjectID: Integer;
  231. begin
  232. InitResultGrid;
  233. for i := 0 to FSelectProjs.Count - 1 do
  234. begin
  235. iProjectID := Integer(FSelectProjs.Items[i]);
  236. stnNode := stdSelectProject.IDTree.FindNode(iProjectID);
  237. if stnNode.Rec.ValueByName('Type').AsInteger = 1 then
  238. begin
  239. zgResult.RowCount := zgResult.RowCount + 1;
  240. zgResult.Cells[1, zgResult.RowCount - 1].Text :=
  241. stnNode.Rec.ValueByName('Name').AsString;
  242. zgResult.Cells[1, zgResult.RowCount - 1].Align := gaCenterLeft;
  243. zgResult.Rows[zgResult.RowCount - 1].Data := stnNode;
  244. end;
  245. end;
  246. end;
  247. procedure TProjGatherSelectForm.LoadHistorySelects(AProjs: TList);
  248. var
  249. i: Integer;
  250. vGatherProjInfo: TGatherProjInfo;
  251. begin
  252. for i := 0 to AProjs.Count - 1 do
  253. begin
  254. vGatherProjInfo := TGatherProjInfo(AProjs.Items[i]);
  255. FSelectProjs.Add(Pointer(vGatherProjInfo.ProjectID));
  256. if (vGatherProjInfo.ProjType > 0) and (vGatherProjInfo.ProjType <= FSpecialProjTypes.Count) then
  257. FSpecialProjIDs[vGatherProjInfo.ProjType-1] := vGatherProjInfo.ProjectID;
  258. end;
  259. end;
  260. procedure TProjGatherSelectForm.btnOkClick(Sender: TObject);
  261. begin
  262. if zgResult.RowCount > 1 then
  263. ModalResult := mrOk;
  264. end;
  265. procedure TProjGatherSelectForm.AssignResult(AProjs: TList);
  266. function SpecialProjType(AID: Integer): Integer;
  267. var
  268. i: Integer;
  269. begin
  270. Result := 0;
  271. for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
  272. begin
  273. if AID = FSpecialProjIDs[i] then
  274. begin
  275. Result := i+1;
  276. Break;
  277. end;
  278. end;
  279. end;
  280. var
  281. iRow: Integer;
  282. stnNode: TsdIDTreeNode;
  283. vGatherProj: TGatherProjInfo;
  284. begin
  285. AProjs.Clear;
  286. for iRow := 1 to zgResult.RowCount - 1 do
  287. begin
  288. stnNode := TsdIDTreeNode(zgResult.Rows[iRow].Data);
  289. vGatherProj := TGatherProjInfo.Create(stnNode.Rec, SpecialProjType(stnNode.ID));
  290. AProjs.Add(vGatherProj);
  291. end;
  292. end;
  293. procedure TProjGatherSelectForm.zgSelectProjectDrawCellText(
  294. ACanvas: TCanvas; const ARect: TRect; const ACoord: TPoint;
  295. AGrid: TZJGrid; const Text: String; var ADefaultDraw: Boolean);
  296. procedure GetBitmap(AImage: TBitmap);
  297. begin
  298. with stdSelectProject.IDTree.Items[ACoord.Y - 1] do
  299. if Rec.ValueByName('Type').AsInteger = 0 then
  300. if Expanded and HasChildren then
  301. MainForm.Images.GetBitmap(34, AImage)
  302. else
  303. MainForm.Images.GetBitmap(34, AImage)
  304. else
  305. MainForm.Images.GetBitmap(11, AImage);
  306. end;
  307. const
  308. rIconWidth = 16;
  309. rIconHeight = 16;
  310. var
  311. Img: TBitmap;
  312. Cell: TZjCell;
  313. rImg: TRect;
  314. begin
  315. if (ACoord.X = 2) and (ACoord.Y > zgSelectProject.FixedRowCount - 1) then
  316. begin
  317. Cell := zgSelectProject.Cells[ACoord.X, ACoord.Y];
  318. Img := TBitmap.Create;
  319. try
  320. GetBitmap(Img);
  321. case Cell.Align of
  322. gaTopLeft, gaTopCenter, gaTopRight:
  323. rImg := Rect(ARect.Left + 2, ARect.Top, ARect.Left + rIconWidth, ARect.Top + rIconHeight);
  324. gaCenterLeft, gaCenterCenter, gaCenterRight:
  325. 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);
  326. gaBottomLeft, gaBottomCenter, gaBottomRight:
  327. rImg := Rect(ARect.Left + 2, ARect.Bottom - rIconHeight, ARect.Left + rIconWidth, ARect.Bottom);
  328. end;
  329. ACanvas.StretchDraw(rImg, Img);
  330. WriteText(ACanvas, Rect(ARect.Left + rIconWidth, ARect.Top, ARect.Right, ARect.Bottom)
  331. , 2, 2, Text, Cell.Align, False);
  332. ADefaultDraw := False;
  333. finally
  334. Img.Free;
  335. end;
  336. end;
  337. end;
  338. procedure TProjGatherSelectForm.zgResultGetCellText(Sender: TObject;
  339. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  340. begin
  341. if (ACoord.X > 1) and (ACoord.Y > 0) then
  342. begin
  343. if Assigned(zgResult.Rows[ACoord.Y].Data) and (TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data).ID = FSpecialProjIDs[ACoord.X-2]) then
  344. Value := 'True'
  345. else
  346. Value := 'False';
  347. end;
  348. end;
  349. procedure TProjGatherSelectForm.zgResultSetCellText(Sender: TObject;
  350. const ACoord: TPoint; var Value: String; DisplayText: Boolean);
  351. var
  352. iProjID, i: Integer;
  353. stnNode: TsdIDTreeNode;
  354. begin
  355. if (ACoord.X > 1) and (ACoord.Y > 0) then
  356. begin
  357. stnNode := TsdIDTreeNode(zgResult.Rows[ACoord.Y].Data);
  358. iProjID := stnNode.ID;
  359. if FSpecialProjIDs[ACoord.X-2] <> iProjID then
  360. begin
  361. for i := Low(FSpecialProjIDs) to High(FSpecialProjIDs) do
  362. begin
  363. if FSpecialProjIDs[i] = iProjID then
  364. FSpecialProjIDs[i] := -1
  365. end;
  366. FSpecialProjIDs[ACoord.X-2] := iProjID;
  367. end
  368. else
  369. FSpecialProjIDs[ACoord.X-2] := -1;
  370. for i := 0 to FSpecialProjTypes.Count - 1 do
  371. zgResult.InvalidateCol(i+2);
  372. end;
  373. end;
  374. end.