SearchDm.pas 6.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257
  1. unit SearchDm;
  2. interface
  3. uses
  4. SysUtils, Classes, DB, DBClient, sdIDTree, sdDB, BillsTree;
  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. cdsSearchSerialNo: TIntegerField;
  20. procedure cdsSearchQuantityGetText(Sender: TField; var Text: String;
  21. DisplayText: Boolean);
  22. private
  23. FProjectData: TObject;
  24. procedure AddSearchResult(ANode: TMeasureBillsIDTreeNode);
  25. public
  26. constructor Create(AProjectData: TObject);
  27. destructor Destroy; override;
  28. procedure SearchKeyword(const AKeyword: string);
  29. procedure SearchOverRange;
  30. procedure SearchBelowRange;
  31. procedure SearchRelaFile;
  32. procedure LocateCurrent(ALocateType: TLocateType);
  33. property ProjectData: TObject read FProjectData;
  34. end;
  35. implementation
  36. uses
  37. ProjectData, BillsMeasureDm, BillsCompileDm, Math, ZhAPI,
  38. UtilMethods, Forms, Controls;
  39. {$R *.dfm}
  40. { TSearchData }
  41. procedure TSearchData.AddSearchResult(ANode: TMeasureBillsIDTreeNode);
  42. begin
  43. if not Assigned(ANode) then Exit;
  44. cdsSearch.Append;
  45. with ANode do
  46. begin
  47. cdsSearchID.AsInteger := Rec.ValueByName('ID').AsInteger;
  48. cdsSearchCode.AsString := Rec.ValueByName('Code').AsString;
  49. cdsSearchB_Code.AsString := Rec.ValueByName('B_Code').AsString;
  50. cdsSearchName.AsString := Rec.ValueByName('Name').AsString;
  51. cdsSearchUnits.AsString := Rec.ValueByName('Units').AsString;
  52. cdsSearchPrice.AsFloat := Rec.ValueByName('Price').AsFloat;
  53. cdsSearchQuantity.AsString := Rec.ValueByName('Quantity').AsString;
  54. if Assigned(StageRec) then
  55. cdsSearchCurQcQuantity.AsFloat := StageRec.ValueByName('QcQuantity').AsFloat;
  56. cdsSearchAddGatherQuantity.AsString := Rec.ValueByName('AddGatherQuantity').AsString;
  57. if cdsSearchQuantity.AsFloat <> 0 then
  58. cdsSearchCompleteRate.AsFloat := advRoundTo(
  59. Rec.ValueByName('AddDealQuantity').AsFloat/cdsSearchQuantity.AsFloat*100);
  60. end;
  61. cdsSearch.Post;
  62. end;
  63. constructor TSearchData.Create(AProjectData: TObject);
  64. begin
  65. inherited Create(nil);
  66. FProjectData := AProjectData;
  67. end;
  68. destructor TSearchData.Destroy;
  69. begin
  70. inherited;
  71. end;
  72. procedure TSearchData.LocateCurrent(ALocateType: TLocateType);
  73. procedure LocateCompile;
  74. var
  75. stnNode: TsdIDTreeNode;
  76. begin
  77. with TProjectData(FProjectData).BillsCompileData do
  78. begin
  79. stnNode := BillsCompileTree.FindNode(cdsSearchID.AsInteger);
  80. if not Assigned(stnNode) then Exit;
  81. sdvBillsCompile.LocateInControl(stnNode.Rec);
  82. end;
  83. end;
  84. procedure LocateMeasure;
  85. var
  86. stnNode: TsdIDTreeNode;
  87. begin
  88. with TProjectData(FProjectData).BillsMeasureData do
  89. begin
  90. stnNode := BillsMeasureTree.FindNode(cdsSearchID.AsInteger);
  91. if not Assigned(stnNode) then Exit;
  92. sdvBillsMeasure.LocateInControl(stnNode.Rec);
  93. end;
  94. end;
  95. begin
  96. Screen.Cursor := crHourGlass;
  97. try
  98. if ALocateType = ltCompile then
  99. LocateCompile
  100. else if ALocateType = ltMeasure then
  101. LocateMeasure;
  102. finally
  103. Screen.Cursor := crDefault;
  104. end;
  105. end;
  106. procedure TSearchData.SearchKeyword(const AKeyword: string);
  107. var
  108. iNode: Integer;
  109. vNode: TMeasureBillsIDTreeNode;
  110. begin
  111. if AKeyword = '' then Exit;
  112. cdsSearch.DisableControls;
  113. try
  114. cdsSearch.EmptyDataSet;
  115. with TProjectData(FProjectData).BillsMeasureData do
  116. begin
  117. for iNode := 0 to BillsMeasureTree.Count - 1 do
  118. begin
  119. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[iNode]);
  120. if (Pos(AKeyword, vNode.Rec.B_Code.AsString) > 0) or
  121. (Pos(AKeyword, vNode.Rec.Name.AsString) > 0) or
  122. (Pos(AKeyword, vNode.Rec.Code.AsString) > 0) then
  123. AddSearchResult(vNode);
  124. end;
  125. end;
  126. finally
  127. cdsSearch.EnableControls;
  128. end;
  129. end;
  130. procedure TSearchData.SearchOverRange;
  131. function CheckOverRange(ANode: TMeasureBillsIDTreeNode): Boolean;
  132. begin
  133. if ANode.Rec.CalcType.AsInteger = 0 then
  134. Result := ANode.Rec.Quantity.AsFloat < ANode.Rec.AddDealQuantity.AsFloat
  135. else
  136. Result := ANode.Rec.TotalPrice.AsFloat < ANode.Rec.AddDealTotalPrice.AsFloat;
  137. end;
  138. var
  139. i: Integer;
  140. vNode: TMeasureBillsIDTreeNode;
  141. begin
  142. cdsSearch.DisableControls;
  143. try
  144. cdsSearch.EmptyDataSet;
  145. with TProjectData(FProjectData).BillsMeasureData do
  146. begin
  147. for i := 0 to BillsMeasureTree.Count - 1 do
  148. begin
  149. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  150. if not vNode.HasChildren and CheckOverRange(vNode) then
  151. AddSearchResult(vNode);
  152. end;
  153. end;
  154. finally
  155. cdsSearch.EnableControls;
  156. end;
  157. end;
  158. procedure TSearchData.cdsSearchQuantityGetText(Sender: TField;
  159. var Text: String; DisplayText: Boolean);
  160. begin
  161. if Sender.AsFloat = 0 then
  162. Text := ''
  163. else
  164. Text := Sender.AsString;
  165. end;
  166. procedure TSearchData.SearchBelowRange;
  167. var
  168. i: Integer;
  169. vNode: TMeasureBillsIDTreeNode;
  170. begin
  171. cdsSearch.DisableControls;
  172. try
  173. cdsSearch.EmptyDataSet;
  174. with TProjectData(FProjectData).BillsMeasureData do
  175. begin
  176. for i := 0 to BillsMeasureTree.Count - 1 do
  177. begin
  178. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  179. if not vNode.HasChildren then
  180. if vNode.Rec.Quantity.AsFloat > vNode.Rec.AddDealQuantity.AsFloat then
  181. AddSearchResult(vNode);
  182. end;
  183. end;
  184. finally
  185. cdsSearch.EnableControls;
  186. end;
  187. end;
  188. procedure TSearchData.SearchRelaFile;
  189. function HasRelaFile(vNode: TMeasureBillsIDTreeNode): Boolean;
  190. var
  191. i: Integer;
  192. begin
  193. Result := False;
  194. with TProjectData(FProjectData) do
  195. for i := 0 to AttachmentData.Count - 1 do
  196. begin
  197. if (AttachmentData[i].BillID = vNode.Rec.ID.AsInteger) and (AttachmentData[i].Phase = PhaseIndex) then
  198. begin
  199. Result := True;
  200. Break;
  201. end;
  202. end;
  203. end;
  204. var
  205. i: Integer;
  206. vNode: TMeasureBillsIDTreeNode;
  207. begin
  208. cdsSearch.DisableControls;
  209. try
  210. cdsSearch.EmptyDataSet;
  211. with TProjectData(FProjectData).BillsMeasureData do
  212. begin
  213. for i := 0 to BillsMeasureTree.Count - 1 do
  214. begin
  215. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  216. if vNode.Rec.HasAttachment.AsBoolean or HasRelaFile(vNode) then
  217. AddSearchResult(vNode);
  218. end;
  219. end;
  220. finally
  221. cdsSearch.EnableControls;
  222. end;
  223. end;
  224. end.