123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293 |
- unit rmGclBillsAuditCompareDm;
- interface
- uses
- SysUtils, Classes, DB, DBClient, ProjectData, sdIDTree, sdDB;
- type
- TrmFilterType = (rmftPhaseDeal, rmftPhaseQc, rmftPhasePc, rmftPhaseGather);
- TDataType = (atRefer, atReply);
- TGclNode = class
- private
- FB_Code: string;
- FIndexCode: string;
- FName: string;
- FUnits: string;
- FPrice: Double;
- FNewPrice: Double;
- FReferCurDealQuantity: Double;
- FReferCurDealTotalPrice: Double;
- FReferCurQcQuantity: Double;
- FReferCurQcTotalPrice: Double;
- FReferCurQcBGLCode: string;
- FReferCurPcQuantity: Double;
- FReferCurPcTotalPrice: Double;
- FReferCurPcBGLCode: string;
- FReferCurGatherQuantity: Double;
- FReferCurGatherTotalPrice: Double;
- FReplyCurDealQuantity: Double;
- FReplyCurDealTotalPrice: Double;
- FReplyCurQcQuantity: Double;
- FReplyCurQcTotalPrice: Double;
- FReplyCurQcBGLCode: string;
- FReplyCurPcQuantity: Double;
- FReplyCurPcTotalPrice: Double;
- FReplyCurPcBGLCode: string;
- FReplyCurGatherQuantity: Double;
- FReplyCurGatherTotalPrice: Double;
- end;
- TrmGclBillsAuditCompareData = class(TDataModule)
- cdsBills: TClientDataSet;
- cdsBillsB_Code: TStringField;
- cdsBillsIndexCode: TStringField;
- cdsBillsName: TWideStringField;
- cdsBillsUnits: TWideStringField;
- cdsBillsPrice: TFloatField;
- cdsBillsNewPrice: TFloatField;
- cdsBillsReferCurDealQuantity: TFloatField;
- cdsBillsReferCurDealTotalPrice: TFloatField;
- cdsBillsReferCurQcQuantity: TFloatField;
- cdsBillsReferCurQcTotalPrice: TFloatField;
- cdsBillsReferCurQcBGLCode: TWideStringField;
- cdsBillsReferCurPcQuantity: TFloatField;
- cdsBillsReferCurPcTotalPrice: TFloatField;
- cdsBillsReferCurPcBGLCode: TWideStringField;
- cdsBillsReferCurGatherQuantity: TFloatField;
- cdsBillsReferCurGatherTotalPrice: TFloatField;
- cdsBillsReplyCurDealQuantity: TFloatField;
- cdsBillsReplyCurDealTotalPrice: TFloatField;
- cdsBillsReplyCurQcQuantity: TFloatField;
- cdsBillsReplyCurQcTotalPrice: TFloatField;
- cdsBillsReplyCurQcBGLCode: TWideStringField;
- cdsBillsReplyCurPcQuantity: TFloatField;
- cdsBillsReplyCurPcTotalPrice: TFloatField;
- cdsBillsReplyCurPcBGLCode: TWideStringField;
- cdsBillsReplyCurGatherQuantity: TFloatField;
- cdsBillsReplyCurGatherTotalPrice: TFloatField;
- cdsBillsFlowIndex: TIntegerField;
- private
- FProjectData: TProjectData;
- FrmFilterType: TrmFilterType;
- FGclList: TList;
- procedure FilterGclBills(ANode: TsdIDTreeNode; ADataType: TDataType);
- procedure FilterBills(ANode: TsdIDTreeNode; ADataType: TDataType);
- procedure WriteBills;
- public
- constructor Create;
- destructor Destroy; override;
- function AssignData(AProjectData: TProjectData;
- ArmFilterType: TrmFilterType): TDataSet;
- end;
- implementation
- uses
- ZhAPI, UtilMethods, PhaseData;
- {$R *.dfm}
- { TrmGclBillsAuditCompareData }
- function TrmGclBillsAuditCompareData.AssignData(AProjectData: TProjectData;
- ArmFilterType: TrmFilterType): TDataSet;
- var
- iStageMark: Integer;
- begin
- FProjectData := AProjectData;
- FrmFilterType := ArmFilterType;
- cdsBills.Active := True;
- cdsBills.DisableControls;
- try
- cdsBills.EmptyDataSet;
- if FProjectData.PhaseData.Active then
- with FProjectData.BillsMeasureData.BillsMeasureTree do
- begin
- iStageMark := FProjectData.PhaseData.StageIndex;
- FProjectData.PhaseData.StageIndex := 0;
- FilterBills(FirstNode, atRefer);
- if FProjectData.PhaseData.StageCount > 1 then
- begin
- FProjectData.PhaseData.StageIndex := FProjectData.PhaseData.AuditCount;
- FilterBills(FirstNode, atReply);
- end;
- end;
- WriteBills;
- finally
- FProjectData.PhaseData.StageIndex := iStageMark;
- ClearObjects(FGclList);
- cdsBills.EnableControls;
- Result := cdsBills;
- end;
- end;
- constructor TrmGclBillsAuditCompareData.Create;
- begin
- inherited Create(nil);
- FGclList := TList.Create;
- cdsBills.IndexFieldNames := 'IndexCode';
- end;
- destructor TrmGclBillsAuditCompareData.Destroy;
- begin
- ClearObjects(FGclList);
- FGclList.Free;
- inherited;
- end;
- procedure TrmGclBillsAuditCompareData.FilterBills(ANode: TsdIDTreeNode;
- ADataType: TDataType);
- begin
- if not Assigned(ANode) then Exit;
- if ANode.HasChildren then
- FilterBills(ANode.FirstChild, ADataType)
- else
- FilterGclBills(ANode, ADataType);
- FilterBills(ANode.NextSibling, ADataType);
- end;
- procedure TrmGclBillsAuditCompareData.FilterGclBills(ANode: TsdIDTreeNode;
- ADataType: TDataType);
- function CreateGclNode(ARec: TsdDataRecord): TGclNode;
- begin
- Result := TGclNode.Create;
- FGclList.Add(Result);
- Result.FB_Code := ARec.ValueByName('B_Code').AsString;
- Result.FIndexCode := B_CodeToIndexCode(ARec.ValueByName('B_Code').AsString);
- Result.FName := ARec.ValueByName('Name').AsString;
- Result.FUnits := ARec.ValueByName('Units').AsString;
- Result.FPrice := ARec.ValueByName('Price').AsFloat;
- Result.FNewPrice := ARec.ValueByName('NewPrice').AsFloat;
- end;
- function GetGclNode(ARec: TsdDataRecord): TGclNode;
- var
- I: Integer;
- GclNode: TGclNode;
- begin
- Result := nil;
- for I := 0 to FGclList.Count - 1 do
- begin
- GclNode := TGclNode(FGclList.Items[I]);
- if SameText(GclNode.FB_Code, ARec.ValueByName('B_Code').AsString) and
- SameText(GclNode.FName, ARec.ValueByName('Name').AsString) and
- SameText(GclNode.FUnits, ARec.ValueByName('Units').AsString) and
- (GclNode.FPrice = ARec.ValueByName('Price').AsFloat) then
- begin
- Result := GclNode;
- Break;
- end;
- end;
- if not Assigned(Result) then
- Result := CreateGclNode(ARec);
- end;
- procedure LoadReferData(AGclNode: TGclNode; ARec: TsdDataRecord);
- begin
- AGclNode.FReferCurDealQuantity := AGclNode.FReferCurDealQuantity + ARec.ValueByName('DealQuantity').AsFloat;
- AGclNode.FReferCurDealTotalPrice := AGclNode.FReferCurDealTotalPrice + ARec.ValueByName('DealTotalPrice').AsFloat;
- AGclNode.FReferCurQcQuantity := AGclNode.FReferCurQcQuantity + ARec.ValueByName('QcQuantity').AsFloat;
- AGclNode.FReferCurQcTotalPrice := AGclNode.FReferCurQcTotalPrice + ARec.ValueByName('QcTotalPrice').AsFloat;
- AGclNode.FReferCurQcBGLCode := MergeRelaBGL(AGclNode.FReferCurQcBGLCode, ARec.ValueByName('QcBGLCode').AsString);
- AGclNode.FReferCurPcQuantity := AGclNode.FReferCurPcQuantity + ARec.ValueByName('PcQuantity').AsFloat;
- AGclNode.FReferCurPcTotalPrice := AGclNode.FReferCurPcTotalPrice + ARec.ValueByName('PcTotalPrice').AsFloat;
- AGclNode.FReferCurPcBGLCode := MergeRelaBGL(AGclNode.FReferCurPcBGLCode, ARec.ValueByName('PcBGLCode').AsString);
- AGclNode.FReferCurGatherQuantity := AGclNode.FReferCurGatherQuantity + ARec.ValueByName('GatherQuantity').AsFloat;
- AGclNode.FReferCurGatherTotalPrice := AGclNode.FReferCurGatherTotalPrice + ARec.ValueByName('GatherTotalPrice').AsFloat;
- end;
- procedure LoadReplyData(AGclNode: TGclNode; ARec: TsdDataRecord);
- begin
- AGclNode.FReplyCurDealQuantity := AGclNode.FReplyCurDealQuantity + ARec.ValueByName('DealQuantity').AsFloat;
- AGclNode.FReplyCurDealTotalPrice := AGclNode.FReplyCurDealTotalPrice + ARec.ValueByName('DealTotalPrice').AsFloat;
- AGclNode.FReplyCurQcQuantity := AGclNode.FReplyCurQcQuantity + ARec.ValueByName('QcQuantity').AsFloat;
- AGclNode.FReplyCurQcTotalPrice := AGclNode.FReplyCurQcTotalPrice + ARec.ValueByName('QcTotalPrice').AsFloat;
- AGclNode.FReplyCurQcBGLCode := MergeRelaBGL(AGclNode.FReplyCurQcBGLCode, ARec.ValueByName('QcBGLCode').AsString);
- AGclNode.FReplyCurPcQuantity := AGclNode.FReplyCurPcQuantity + ARec.ValueByName('PcQuantity').AsFloat;
- AGclNode.FReplyCurPcTotalPrice := AGclNode.FReplyCurPcTotalPrice + ARec.ValueByName('PcTotalPrice').AsFloat;
- AGclNode.FReplyCurPcBGLCode := MergeRelaBGL(AGclNode.FReplyCurPcBGLCode, ARec.ValueByName('PcBGLCode').AsString);
- AGclNode.FReplyCurGatherQuantity := AGclNode.FReplyCurGatherQuantity + ARec.ValueByName('GatherQuantity').AsFloat;
- AGclNode.FReplyCurGatherTotalPrice := AGclNode.FReplyCurGatherTotalPrice + ARec.ValueByName('GatherTotalPrice').AsFloat;
- end;
- var
- Rec, StageRec: TsdDataRecord;
- GclNode: TGclNode;
- begin
- if not Assigned(ANode) then Exit;
- Rec := ANode.Rec;
- if Rec.ValueByName('B_Code').AsString = '' then Exit;
- StageRec := TProjectData(FProjectData).PhaseData.StageData.StageRecord(ANode.ID);
- {case ADataType of
- atRefer: StageRec := TProjectData(FProjectData).PhaseData.ReferData.StageRecord(ANode.ID);
- atReply: StageRec := TProjectData(FProjectData).PhaseData.LastStageData.StageRecord(ANode.ID);
- end;}
- if not Assigned(StageRec) then Exit;
- case FrmFilterType of
- rmftPhaseDeal: if StageRec.ValueByName('DealTotalPrice').AsFloat = 0 then Exit;
- rmftPhaseQc: if StageRec.ValueByName('QcTotalPrice').AsFloat = 0 then Exit;
- rmftPhasePc: if StageRec.ValueByName('PcTotalPrice').AsFloat = 0 then Exit;
- rmftPhaseGather: if StageRec.ValueByName('GatherTotalPrice').AsFloat = 0 then Exit;
- end;
- GclNode := GetGclNode(Rec);
- case ADataType of
- atRefer: LoadReferData(GclNode, StageRec);
- atReply: LoadReplyData(GclNode, StageRec);
- end;
- end;
- procedure TrmGclBillsAuditCompareData.WriteBills;
- var
- I: Integer;
- GclNode: TGclNode;
- begin
- for I := 0 to FGclList.Count - 1 do
- begin
- GclNode := TGclNode(FGclList.Items[I]);
- cdsBills.Append;
- cdsBillsB_Code.AsString := GclNode.FB_Code;
- cdsBillsIndexCode.AsString := GclNode.FIndexCode;
- cdsBillsName.AsString := GclNode.FName;
- cdsBillsUnits.AsString := GclNode.FUnits;
- cdsBillsPrice.AsFloat := GclNode.FPrice;
- cdsBillsNewPrice.AsFloat := GclNode.FNewPrice;
- cdsBillsReferCurDealQuantity.AsFloat := GclNode.FReferCurDealQuantity;
- cdsBillsReferCurDealTotalPrice.AsFloat := GclNode.FReferCurDealTotalPrice;
- cdsBillsReferCurQcQuantity.AsFloat := GclNode.FReferCurQcQuantity;
- cdsBillsReferCurQcTotalPrice.AsFloat := GclNode.FReferCurQcTotalPrice;
- cdsBillsReferCurQcBGLCode.AsString := GclNode.FReferCurQcBGLCode;
- cdsBillsReferCurPcQuantity.AsFloat := GclNode.FReferCurPcQuantity;
- cdsBillsReferCurPcTotalPrice.AsFloat := GclNode.FReferCurPcTotalPrice;
- cdsBillsReferCurPcBGLCode.AsString := GclNode.FReferCurPcBGLCode;
- cdsBillsReferCurGatherQuantity.AsFloat := GclNode.FReferCurGatherQuantity;
- cdsBillsReferCurGatherTotalPrice.AsFloat := GclNode.FReferCurGatherTotalPrice;
- cdsBillsReplyCurDealQuantity.AsFloat := GclNode.FReplyCurDealQuantity;
- cdsBillsReplyCurDealTotalPrice.AsFloat := GclNode.FReplyCurDealTotalPrice;
- cdsBillsReplyCurQcQuantity.AsFloat := GclNode.FReplyCurQcQuantity;
- cdsBillsReplyCurQcTotalPrice.AsFloat := GclNode.FReplyCurQcTotalPrice;
- cdsBillsReplyCurQcBGLCode.AsString := GclNode.FReplyCurQcBGLCode;
- cdsBillsReplyCurPcQuantity.AsFloat := GclNode.FReplyCurPcQuantity;
- cdsBillsReplyCurPcTotalPrice.AsFloat := GclNode.FReplyCurPcTotalPrice;
- cdsBillsReplyCurPcBGLCode.AsString := GclNode.FReplyCurPcBGLCode;
- cdsBillsReplyCurGatherQuantity.AsFloat := GclNode.FReplyCurGatherQuantity;
- cdsBillsReplyCurGatherTotalPrice.AsFloat := GclNode.FReplyCurGatherTotalPrice;
- cdsBillsFlowIndex.AsInteger := 0;
- cdsBills.Post;
- end;
- end;
- end.
|