unit SearchDm; interface uses SysUtils, Classes, DB, DBClient, sdIDTree, sdDB; type TLocateType = (ltCompile, ltMeasure); TSearchData = class(TDataModule) cdsSearch: TClientDataSet; cdsSearchCode: TStringField; cdsSearchB_Code: TStringField; cdsSearchName: TWideStringField; cdsSearchUnits: TWideStringField; cdsSearchQuantity: TFloatField; cdsSearchAddGatherQuantity: TFloatField; cdsSearchID: TIntegerField; cdsSearchCurQcQuantity: TFloatField; cdsSearchPrice: TFloatField; cdsSearchCompleteRate: TFloatField; procedure cdsSearchQuantityGetText(Sender: TField; var Text: String; DisplayText: Boolean); private FProjectData: TObject; procedure BeginSearch; procedure EndSearch; procedure AddSearchResult(Rec, StageRec: TsdDataRecord); public constructor Create(AProjectData: TObject); destructor Destroy; override; procedure SearchKeyword(const AKeyword: string); procedure SearchOverRange; procedure SearchBelowRange; procedure LocateCurrent(ALocateType: TLocateType); property ProjectData: TObject read FProjectData; end; implementation uses ProjectData, BillsMeasureDm, BillsCompileDm, Math, ZhAPI; {$R *.dfm} { TSearchData } procedure TSearchData.AddSearchResult(Rec, StageRec: TsdDataRecord); begin cdsSearch.Append; cdsSearchID.AsInteger := Rec.ValueByName('ID').AsInteger; cdsSearchCode.AsString := Rec.ValueByName('Code').AsString; cdsSearchB_Code.AsString := Rec.ValueByName('B_Code').AsString; cdsSearchName.AsString := Rec.ValueByName('Name').AsString; cdsSearchUnits.AsString := Rec.ValueByName('Units').AsString; cdsSearchPrice.AsFloat := Rec.ValueByName('Price').AsFloat; cdsSearchQuantity.AsString := Rec.ValueByName('Quantity').AsString; if Assigned(StageRec) then cdsSearchCurQcQuantity.AsFloat := StageRec.ValueByName('QcQuantity').AsFloat; cdsSearchAddGatherQuantity.AsString := Rec.ValueByName('AddGatherQuantity').AsString; if cdsSearchQuantity.AsFloat <> 0 then cdsSearchCompleteRate.AsFloat := advRoundTo( Rec.ValueByName('AddDealQuantity').AsFloat/cdsSearchQuantity.AsFloat*100); cdsSearch.Post; end; procedure TSearchData.BeginSearch; begin cdsSearch.DisableControls; end; constructor TSearchData.Create(AProjectData: TObject); begin inherited Create(nil); FProjectData := AProjectData; end; destructor TSearchData.Destroy; begin inherited; end; procedure TSearchData.EndSearch; begin cdsSearch.EnableControls; end; procedure TSearchData.LocateCurrent(ALocateType: TLocateType); procedure LocateCompile; var stnNode: TsdIDTreeNode; begin with TProjectData(FProjectData).BillsCompileData do begin stnNode := BillsCompileTree.FindNode(cdsSearchID.AsInteger); sdvBillsCompile.LocateInControl(stnNode.Rec); end; end; procedure LocateMeasure; var stnNode: TsdIDTreeNode; begin with TProjectData(FProjectData).BillsMeasureData do begin stnNode := BillsMeasureTree.FindNode(cdsSearchID.AsInteger); sdvBillsMeasure.LocateInControl(stnNode.Rec); end; end; begin if ALocateType = ltCompile then LocateCompile else if ALocateType = ltMeasure then LocateMeasure; end; procedure TSearchData.SearchKeyword(const AKeyword: string); procedure CheckKeyword(ANode: TsdIDTreeNode); var Rec, StageRec: TsdDataRecord; begin Rec := ANode.Rec; StageRec := TProjectData(FProjectData).PhaseData.StageData.StageRecord(ANode.ID); // Task 不查询项目节,仅查询工程量清单 if {(Pos(AKeyword, Rec.ValueByName('Code').AsString) > 0) or} (Pos(AKeyword, Rec.ValueByName('B_Code').AsString) > 0) or (Pos(AKeyword, Rec.ValueByName('Name').AsString) > 0) then begin AddSearchResult(Rec, StageRec); end; end; procedure RecursiveSearchKeyword(ANode: TsdIDTreeNode); begin if not Assigned(ANode) then Exit; CheckKeyword(ANode); if ANode.HasChildren then RecursiveSearchKeyword(ANode.FirstChild); RecursiveSearchKeyword(ANode.NextSibling); end; begin if AKeyword = '' then Exit; BeginSearch; try cdsSearch.EmptyDataSet; with TProjectData(FProjectData).BillsMeasureData do RecursiveSearchKeyword(BillsMeasureTree.FirstNode); finally EndSearch; end; end; procedure TSearchData.SearchOverRange; procedure CheckOverRange(ANode: TsdIDTreeNode); var Rec, StageRec: TsdDataRecord; begin Rec := ANode.Rec; StageRec := TProjectData(FProjectData).PhaseData.StageData.StageRecord(ANode.ID); if Rec.ValueByName('Quantity').AsFloat < Rec.ValueByName('AddDealQuantity').AsFloat then begin AddSearchResult(Rec, StageRec) end; end; procedure RecursiveSearchOverRange(ANode: TsdIDTreeNode); begin if not Assigned(ANode) then Exit; if ANode.HasChildren then RecursiveSearchOverRange(ANode.FirstChild) else CheckOverRange(ANode); RecursiveSearchOverRange(ANode.NextSibling); end; begin BeginSearch; try cdsSearch.EmptyDataSet; with TProjectData(FProjectData).BillsMeasureData do RecursiveSearchOverRange(BillsMeasureTree.FirstNode); finally EndSearch; end; end; procedure TSearchData.cdsSearchQuantityGetText(Sender: TField; var Text: String; DisplayText: Boolean); begin if Sender.AsFloat = 0 then Text := '' else Text := Sender.AsString; end; procedure TSearchData.SearchBelowRange; procedure CheckBelowRange(ANode: TsdIDTreeNode); var Rec, StageRec: TsdDataRecord; begin Rec := ANode.Rec; if Rec.ValueByName('Quantity').AsFloat = 0 then Exit; StageRec := TProjectData(FProjectData).PhaseData.StageData.StageRecord(ANode.ID); if Rec.ValueByName('Quantity').AsFloat > Rec.ValueByName('AddDealQuantity').AsFloat then begin AddSearchResult(Rec, StageRec) end; end; procedure RecursiveSearchBelowRange(ANode: TsdIDTreeNode); begin if not Assigned(ANode) then Exit; if ANode.HasChildren then RecursiveSearchBelowRange(ANode.FirstChild) else CheckBelowRange(ANode); RecursiveSearchBelowRange(ANode.NextSibling); end; begin BeginSearch; try cdsSearch.EmptyDataSet; with TProjectData(FProjectData).BillsMeasureData do RecursiveSearchBelowRange(BillsMeasureTree.FirstNode); finally EndSearch; end; end; end.