SearchDm.pas 5.5 KB

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