SearchDm.pas 6.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243
  1. unit SearchDm;
  2. interface
  3. uses
  4. SysUtils, Classes, DB, DBClient, sdIDTree, sdDB;
  5. type
  6. TLocateType = (ltCompile, ltMeasure);
  7. TSearchData = class(TDataModule)
  8. cdsSearch: TClientDataSet;
  9. cdsSearchCode: TStringField;
  10. cdsSearchB_Code: TStringField;
  11. cdsSearchName: TWideStringField;
  12. cdsSearchUnits: TWideStringField;
  13. cdsSearchQuantity: TFloatField;
  14. cdsSearchAddGatherQuantity: TFloatField;
  15. cdsSearchID: TIntegerField;
  16. cdsSearchCurQcQuantity: TFloatField;
  17. cdsSearchPrice: TFloatField;
  18. cdsSearchCompleteRate: TFloatField;
  19. procedure cdsSearchQuantityGetText(Sender: TField; var Text: String;
  20. DisplayText: Boolean);
  21. private
  22. FProjectData: TObject;
  23. procedure BeginSearch;
  24. procedure EndSearch;
  25. procedure AddSearchResult(Rec, StageRec: TsdDataRecord);
  26. public
  27. constructor Create(AProjectData: TObject);
  28. destructor Destroy; override;
  29. procedure SearchKeyword(const AKeyword: string);
  30. procedure SearchOverRange;
  31. procedure SearchBelowRange;
  32. procedure LocateCurrent(ALocateType: TLocateType);
  33. property ProjectData: TObject read FProjectData;
  34. end;
  35. implementation
  36. uses
  37. ProjectData, BillsMeasureDm, BillsCompileDm, Math, ZhAPI;
  38. {$R *.dfm}
  39. { TSearchData }
  40. procedure TSearchData.AddSearchResult(Rec, StageRec: TsdDataRecord);
  41. begin
  42. cdsSearch.Append;
  43. cdsSearchID.AsInteger := Rec.ValueByName('ID').AsInteger;
  44. cdsSearchCode.AsString := Rec.ValueByName('Code').AsString;
  45. cdsSearchB_Code.AsString := Rec.ValueByName('B_Code').AsString;
  46. cdsSearchName.AsString := Rec.ValueByName('Name').AsString;
  47. cdsSearchUnits.AsString := Rec.ValueByName('Units').AsString;
  48. cdsSearchPrice.AsFloat := Rec.ValueByName('Price').AsFloat;
  49. cdsSearchQuantity.AsString := Rec.ValueByName('Quantity').AsString;
  50. if Assigned(StageRec) then
  51. cdsSearchCurQcQuantity.AsFloat := StageRec.ValueByName('QcQuantity').AsFloat;
  52. cdsSearchAddGatherQuantity.AsString := Rec.ValueByName('AddGatherQuantity').AsString;
  53. if cdsSearchQuantity.AsFloat <> 0 then
  54. cdsSearchCompleteRate.AsFloat := advRoundTo(
  55. Rec.ValueByName('AddDealQuantity').AsFloat/cdsSearchQuantity.AsFloat*100);
  56. cdsSearch.Post;
  57. end;
  58. procedure TSearchData.BeginSearch;
  59. begin
  60. cdsSearch.DisableControls;
  61. end;
  62. constructor TSearchData.Create(AProjectData: TObject);
  63. begin
  64. inherited Create(nil);
  65. FProjectData := AProjectData;
  66. end;
  67. destructor TSearchData.Destroy;
  68. begin
  69. inherited;
  70. end;
  71. procedure TSearchData.EndSearch;
  72. begin
  73. cdsSearch.EnableControls;
  74. end;
  75. procedure TSearchData.LocateCurrent(ALocateType: TLocateType);
  76. procedure LocateCompile;
  77. var
  78. stnNode: TsdIDTreeNode;
  79. begin
  80. with TProjectData(FProjectData).BillsCompileData do
  81. begin
  82. stnNode := BillsCompileTree.FindNode(cdsSearchID.AsInteger);
  83. sdvBillsCompile.LocateInControl(stnNode.Rec);
  84. end;
  85. end;
  86. procedure LocateMeasure;
  87. var
  88. stnNode: TsdIDTreeNode;
  89. begin
  90. with TProjectData(FProjectData).BillsMeasureData do
  91. begin
  92. stnNode := BillsMeasureTree.FindNode(cdsSearchID.AsInteger);
  93. sdvBillsMeasure.LocateInControl(stnNode.Rec);
  94. end;
  95. end;
  96. begin
  97. if ALocateType = ltCompile then
  98. LocateCompile
  99. else if ALocateType = ltMeasure then
  100. LocateMeasure;
  101. end;
  102. procedure TSearchData.SearchKeyword(const AKeyword: string);
  103. procedure CheckKeyword(ANode: TsdIDTreeNode);
  104. var
  105. Rec, StageRec: TsdDataRecord;
  106. begin
  107. Rec := ANode.Rec;
  108. StageRec := TProjectData(FProjectData).PhaseData.StageData.StageRecord(ANode.ID);
  109. // Task 꼇꿴璂淃커쌘,쏭꿴璂묏넋좆헌데
  110. if {(Pos(AKeyword, Rec.ValueByName('Code').AsString) > 0) or}
  111. (Pos(AKeyword, Rec.ValueByName('B_Code').AsString) > 0) or
  112. (Pos(AKeyword, Rec.ValueByName('Name').AsString) > 0) then
  113. begin
  114. AddSearchResult(Rec, StageRec);
  115. end;
  116. end;
  117. procedure RecursiveSearchKeyword(ANode: TsdIDTreeNode);
  118. begin
  119. if not Assigned(ANode) then Exit;
  120. CheckKeyword(ANode);
  121. if ANode.HasChildren then
  122. RecursiveSearchKeyword(ANode.FirstChild);
  123. RecursiveSearchKeyword(ANode.NextSibling);
  124. end;
  125. begin
  126. if AKeyword = '' then Exit;
  127. BeginSearch;
  128. try
  129. cdsSearch.EmptyDataSet;
  130. with TProjectData(FProjectData).BillsMeasureData do
  131. RecursiveSearchKeyword(BillsMeasureTree.FirstNode);
  132. finally
  133. EndSearch;
  134. end;
  135. end;
  136. procedure TSearchData.SearchOverRange;
  137. procedure CheckOverRange(ANode: TsdIDTreeNode);
  138. var
  139. Rec, StageRec: TsdDataRecord;
  140. begin
  141. Rec := ANode.Rec;
  142. StageRec := TProjectData(FProjectData).PhaseData.StageData.StageRecord(ANode.ID);
  143. if Rec.ValueByName('Quantity').AsFloat < Rec.ValueByName('AddDealQuantity').AsFloat then
  144. begin
  145. AddSearchResult(Rec, StageRec)
  146. end;
  147. end;
  148. procedure RecursiveSearchOverRange(ANode: TsdIDTreeNode);
  149. begin
  150. if not Assigned(ANode) then Exit;
  151. if ANode.HasChildren then
  152. RecursiveSearchOverRange(ANode.FirstChild)
  153. else
  154. CheckOverRange(ANode);
  155. RecursiveSearchOverRange(ANode.NextSibling);
  156. end;
  157. begin
  158. BeginSearch;
  159. try
  160. cdsSearch.EmptyDataSet;
  161. with TProjectData(FProjectData).BillsMeasureData do
  162. RecursiveSearchOverRange(BillsMeasureTree.FirstNode);
  163. finally
  164. EndSearch;
  165. end;
  166. end;
  167. procedure TSearchData.cdsSearchQuantityGetText(Sender: TField;
  168. var Text: String; DisplayText: Boolean);
  169. begin
  170. if Sender.AsFloat = 0 then
  171. Text := ''
  172. else
  173. Text := Sender.AsString;
  174. end;
  175. procedure TSearchData.SearchBelowRange;
  176. procedure CheckBelowRange(ANode: TsdIDTreeNode);
  177. var
  178. Rec, StageRec: TsdDataRecord;
  179. begin
  180. Rec := ANode.Rec;
  181. if Rec.ValueByName('Quantity').AsFloat = 0 then Exit;
  182. StageRec := TProjectData(FProjectData).PhaseData.StageData.StageRecord(ANode.ID);
  183. if Rec.ValueByName('Quantity').AsFloat > Rec.ValueByName('AddDealQuantity').AsFloat then
  184. begin
  185. AddSearchResult(Rec, StageRec)
  186. end;
  187. end;
  188. procedure RecursiveSearchBelowRange(ANode: TsdIDTreeNode);
  189. begin
  190. if not Assigned(ANode) then Exit;
  191. if ANode.HasChildren then
  192. RecursiveSearchBelowRange(ANode.FirstChild)
  193. else
  194. CheckBelowRange(ANode);
  195. RecursiveSearchBelowRange(ANode.NextSibling);
  196. end;
  197. begin
  198. BeginSearch;
  199. try
  200. cdsSearch.EmptyDataSet;
  201. with TProjectData(FProjectData).BillsMeasureData do
  202. RecursiveSearchBelowRange(BillsMeasureTree.FirstNode);
  203. finally
  204. EndSearch;
  205. end;
  206. end;
  207. end.