123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215 |
- unit SearchDm;
- interface
- uses
- SysUtils, Classes, DB, DBClient, sdIDTree, sdDB, BillsTree;
- 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 AddSearchResult(ANode: TMeasureBillsIDTreeNode);
- 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,
- UtilMethods, Forms, Controls;
- {$R *.dfm}
- { TSearchData }
- procedure TSearchData.AddSearchResult(ANode: TMeasureBillsIDTreeNode);
- begin
- if not Assigned(ANode) then Exit;
- cdsSearch.Append;
- with ANode do
- begin
- 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);
- end;
- cdsSearch.Post;
- end;
- constructor TSearchData.Create(AProjectData: TObject);
- begin
- inherited Create(nil);
- FProjectData := AProjectData;
- end;
- destructor TSearchData.Destroy;
- begin
- inherited;
- end;
- procedure TSearchData.LocateCurrent(ALocateType: TLocateType);
- procedure LocateCompile;
- var
- stnNode: TsdIDTreeNode;
- begin
- with TProjectData(FProjectData).BillsCompileData do
- begin
- stnNode := BillsCompileTree.FindNode(cdsSearchID.AsInteger);
- if not Assigned(stnNode) then Exit;
- sdvBillsCompile.LocateInControl(stnNode.Rec);
- end;
- end;
- procedure LocateMeasure;
- var
- stnNode: TsdIDTreeNode;
- begin
- with TProjectData(FProjectData).BillsMeasureData do
- begin
- stnNode := BillsMeasureTree.FindNode(cdsSearchID.AsInteger);
- if not Assigned(stnNode) then Exit;
- sdvBillsMeasure.LocateInControl(stnNode.Rec);
- end;
- end;
- begin
- Screen.Cursor := crHourGlass;
- try
- if ALocateType = ltCompile then
- LocateCompile
- else if ALocateType = ltMeasure then
- LocateMeasure;
- finally
- Screen.Cursor := crDefault;
- end;
- end;
- procedure TSearchData.SearchKeyword(const AKeyword: string);
- var
- iNode: Integer;
- vNode: TMeasureBillsIDTreeNode;
- begin
- if AKeyword = '' then Exit;
- cdsSearch.DisableControls;
- try
- cdsSearch.EmptyDataSet;
- with TProjectData(FProjectData).BillsMeasureData do
- begin
- for iNode := 0 to BillsMeasureTree.Count - 1 do
- begin
- vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[iNode]);
- if (Pos(AKeyword, vNode.Rec.B_Code.AsString) > 0) or
- (Pos(AKeyword, vNode.Rec.Name.AsString) > 0) then
- AddSearchResult(vNode);
- end;
- end;
- finally
- cdsSearch.EnableControls;
- end;
- end;
- procedure TSearchData.SearchOverRange;
- function CheckOverRange(ANode: TMeasureBillsIDTreeNode): Boolean;
- begin
- if ANode.Rec.CalcType.AsInteger = 0 then
- Result := ANode.Rec.Quantity.AsFloat < ANode.Rec.AddDealQuantity.AsFloat
- else
- Result := ANode.Rec.TotalPrice.AsFloat < ANode.Rec.AddDealTotalPrice.AsFloat;
- end;
- var
- i: Integer;
- vNode: TMeasureBillsIDTreeNode;
- begin
- cdsSearch.DisableControls;
- try
- cdsSearch.EmptyDataSet;
- with TProjectData(FProjectData).BillsMeasureData do
- begin
- for i := 0 to BillsMeasureTree.Count - 1 do
- begin
- vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
- if not vNode.HasChildren and CheckOverRange(vNode) then
- AddSearchResult(vNode);
- end;
- end;
- finally
- cdsSearch.EnableControls;
- 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;
- var
- i: Integer;
- vNode: TMeasureBillsIDTreeNode;
- begin
- cdsSearch.DisableControls;
- try
- cdsSearch.EmptyDataSet;
- with TProjectData(FProjectData).BillsMeasureData do
- begin
- for i := 0 to BillsMeasureTree.Count - 1 do
- begin
- vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
- if not vNode.HasChildren then
- if vNode.Rec.Quantity.AsFloat > vNode.Rec.AddDealQuantity.AsFloat then
- AddSearchResult(vNode);
- end;
- end;
- finally
- cdsSearch.EnableControls;
- end;
- end;
- end.
|