123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947 |
- unit GclBillsGatherModel;
- // 单项目的工程量清单汇总
- interface
- uses
- Classes, mDataRecord, BillsTree;
- type
- TGatherDataWriteEvent = procedure (AGLJs: TList) of object;
- TDetailGclNode = class
- private
- FID: Integer;
- FBillsID: Integer;
- FTreeSerialNo: Integer;
- FLeafXmjID: Integer;
- FXmjCode: string;
- FXmjName: string;
- FXmjUnits: string;
- FPeg: string;
- FNameDanWei: string;
- FNameFenBu: string;
- FNameFenXiang: string;
- FNameUnit: string;
- FPosition: string;
- FDrawingCode: string;
- FQuantity: Double;
- FTotalPrice: Double;
- FCurDealQuantity: Double;
- FCurDealTotalPrice: Double;
- FCurQcQuantity: Double;
- FCurQcTotalPrice: Double;
- FCurGatherQuantity: Double;
- FCurGatherTotalPrice: Double;
- FPreDealQuantity: Double;
- FPreDealTotalPrice: Double;
- FPreQcQuantity: Double;
- FPreQcTotalPrice: Double;
- FPreGatherQuantity: Double;
- FPreGatherTotalPrice: Double;
- FEndDealQuantity: Double;
- FEndDealTotalPrice: Double;
- FEndQcQuantity: Double;
- FEndQcTotalPrice: Double;
- FEndGatherQuantity: Double;
- FEndGatherTotalPrice: Double;
- FAddDealQuantity: Double;
- FAddDealTotalPrice: Double;
- FAddQcQuantity: Double;
- FAddQcTotalPrice: Double;
- FAddGatherQuantity: Double;
- FAddGatherTotalPrice: Double;
- FPM_PreTotalPrice: Double;
- FPM_TotalPrice: Double;
- public
- constructor Create(AID: Integer);
- procedure AddPosData(ALeafXmj, APeg: TBillsIDTreeNode);
- property ID: Integer read FID;
- property BillsID: Integer read FBillsID write FBillsID;
- property TreeSerialNo: Integer read FTreeSerialNo write FTreeSerialNo;
- property LeafXmjID: Integer read FLeafXmjID;
- property XmjCode: string read FXmjCode;
- property XmjName: string read FXmjName;
- property XmjUnits: string read FXmjUnits;
- property Peg: string read FPeg;
- property NameDanWei: string read FNameDanWei;
- property NameFenBu: string read FNameFenBu;
- property NameFenXiang: string read FNameFenXiang;
- property NameUnit: string read FNameUnit;
- property Position: string read FPosition;
- property DrawingCode: string read FDrawingCode;
- property Quantity: Double read FQuantity write FQuantity;
- property TotalPrice: Double read FTotalPrice write FTotalPrice;
- property CurDealQuantity: Double read FCurDealQuantity write FCurDealQuantity;
- property CurDealTotalPrice: Double read FCurDealTotalPrice write FCurDealTotalPrice;
- property CurQcQuantity: Double read FCurQcQuantity write FCurQcQuantity;
- property CurQcTotalPrice: Double read FCurQcTotalPrice write FCurQcTotalPrice;
- property CurGatherQuantity: Double read FCurGatherQuantity write FCurGatherQuantity;
- property CurGatherTotalPrice: Double read FCurGatherTotalPrice write FCurGatherTotalPrice;
- property PreDealQuantity: Double read FPreDealQuantity write FPreDealQuantity;
- property PreDealTotalPrice: Double read FPreGatherTotalPrice write FPreGatherTotalPrice;
- property PreQcQuantity: Double read FPreQcQuantity write FPreQcQuantity;
- property PreQcTotalPrice: Double read FPreQcTotalPrice write FPreQcTotalPrice;
- property PreGatherQuantity: Double read FPreGatherQuantity write FPreGatherQuantity;
- property PreGatherTotalPrice: Double read FPreGatherTotalPrice write FPreGatherTotalPrice;
- property EndDealQuantity: Double read FEndDealQuantity write FEndDealQuantity;
- property EndDealTotalPrice: Double read FEndDealTotalPrice write FEndDealTotalPrice;
- property EndQcQuantity: Double read FEndQcQuantity write FEndQcQuantity;
- property EndQcTotalPrice: Double read FEndQcTotalPrice write FEndQcTotalPrice;
- property EndGatherQuantity: Double read FEndGatherQuantity write FEndGatherQuantity;
- property EndGatherTotalPrice: Double read FEndGatherTotalPrice write FEndGatherTotalPrice;
- property AddDealQuantity: Double read FAddDealQuantity write FAddDealQuantity;
- property AddDealTotalPrice: Double read FAddDealTotalPrice write FAddDealTotalPrice;
- property AddQcQuantity: Double read FAddQcQuantity write FAddQcQuantity;
- property AddQcTotalPrice: Double read FAddQcTotalPrice write FAddQcQuantity;
- property AddGatherQuantity: Double read FAddGatherQuantity write FAddGatherQuantity;
- property AddGatherTotalPrice: Double read FAddGatherTotalPrice write FAddGatherTotalPrice;
- property PM_PreTotalPrice: Double read FPM_PreTotalPrice write FPM_PreTotalPrice;
- property PM_TotalPrice: Double read FPM_TotalPrice write FPM_TotalPrice;
- end;
- TDetailDealNode = class
- private
- FID: Integer;
- FDealID: Integer;
- FQuantity: Double;
- FTotalPrice: Double;
- public
- constructor Create(AID: Integer);
- property ID: Integer read FID;
- property DealID: Integer read FDealID write FDealID;
- property Quantity: Double read FQuantity write FQuantity;
- property TotalPrice: Double read FTotalPrice write FTotalPrice;
- end;
- TDetailBGLNode = class
- private
- FID: Integer;
- FBGBillsID: Integer;
- FBGLID: Integer;
- FBGLCode: string;
- FBGLName: string;
- FBGLApprovalCode: string;
- FBGLDrawingCode: string;
- FQuantity: Double;
- FTotalPrice: Double;
- public
- constructor Create(AID: Integer);
- property ID: Integer read FID;
- property BGBillsID: Integer read FBGBillsID write FBGBillsID;
- property BGLID: Integer read FBGLID write FBGLID;
- property BGLCode: string read FBGLCode write FBGLCode;
- property BGLName: string read FBGLName write FBGLName;
- property BGLApprovalCode: string read FBGLApprovalCode write FBGLApprovalCode;
- property BGLDrawingCode: string read FBGLDrawingCode write FBGLDrawingCode;
- property Quantity: Double read FQuantity write FQuantity;
- property TotalPrice: Double read FTotalPrice write FTotalPrice;
- end;
- TGclNode = class
- private
- FDetailGcls: TList;
- FDetailDeals: TList;
- FDetailBGLs: TList;
- FID: Integer;
- FB_Code: string;
- FIndexCode: string;
- FName: string;
- FUnits: string;
- FPrice: Double;
- FQuantity: Double;
- FTotalPrice: Double;
- FCurDealQuantity: Double;
- FCurDealTotalPrice: Double;
- FCurQcQuantity: Double;
- FCurQcTotalPrice: Double;
- FCurGatherQuantity: Double;
- FCurGatherTotalPrice: Double;
- FPreDealQuantity: Double;
- FPreDealTotalPrice: Double;
- FPreQcQuantity: Double;
- FPreQcTotalPrice: Double;
- FPreGatherQuantity: Double;
- FPreGatherTotalPrice: Double;
- FEndDealQuantity: Double;
- FEndDealTotalPrice: Double;
- FEndQcQuantity: Double;
- FEndQcTotalPrice: Double;
- FEndGatherQuantity: Double;
- FEndGatherTotalPrice: Double;
- FAddDealQuantity: Double;
- FAddDealTotalPrice: Double;
- FAddQcQuantity: Double;
- FAddQcTotalPrice: Double;
- FAddGatherQuantity: Double;
- FAddGatherTotalPrice: Double;
- FDealQuantity: Double;
- FDealTotalPrice: Double;
- FBGLQuantity: Double;
- FBGLTotalPrice: Double;
- FDeal_BGLQuantity: Double;
- FDeal_BGLTotalPrice: Double;
- FDeal_BGLPercent: Double;
- procedure InitCalculate;
- procedure GatherDetailGcl;
- procedure GatherDetailDeal;
- procedure GatherDetailBGL;
- procedure CalculateOther;
- procedure SetB_Code(const Value: string);
- function GetDetailBGL(AIndex: Integer): TDetailBGLNode;
- function GetDetailBGLCount: Integer;
- function GetDetailDeal(AIndex: Integer): TDetailDealNode;
- function GetDetailDealCount: Integer;
- function GetDetailGcl(AIndex: Integer): TDetailGclNode;
- function GetDetailGclCount: Integer;
- public
- constructor Create(AID: Integer);
- destructor Destroy; override;
- function AddDetailGcl(AID: Integer): TDetailGclNode;
- function AddDetailDeal(AID: Integer): TDetailDealNode;
- function AddDetailBGL(AID: Integer): TDetailBGLNode;
- procedure Calculate;
- property ID: Integer read FID;
- property B_Code: string read FB_Code write SetB_Code;
- property IndexCode: string read FIndexCode;
- property Name: string read FName write FName;
- property Units: string read FUnits write FUnits;
- property Price: Double read FPrice write FPrice;
- property Quantity: Double read FQuantity;
- property TotalPrice: Double read FTotalPrice;
- property CurDealQuantity: Double read FCurDealQuantity;
- property CurDealTotalPrice: Double read FCurDealTotalPrice;
- property CurQcQuantity: Double read FCurQcQuantity;
- property CurQcTotalPrice: Double read FCurQcTotalPrice;
- property CurGatherQuantity: Double read FCurGatherQuantity;
- property CurGatherTotalPrice: Double read FCurGatherTotalPrice;
- property PreDealQuantity: Double read FPreDealQuantity;
- property PreDealTotalPrice: Double read FPreGatherTotalPrice;
- property PreQcQuantity: Double read FPreQcQuantity;
- property PreQcTotalPrice: Double read FPreQcTotalPrice;
- property PreGatherQuantity: Double read FPreGatherQuantity;
- property PreGatherTotalPrice: Double read FPreGatherTotalPrice;
- property EndDealQuantity: Double read FEndDealQuantity;
- property EndDealTotalPrice: Double read FEndDealTotalPrice;
- property EndQcQuantity: Double read FEndQcQuantity;
- property EndQcTotalPrice: Double read FEndQcTotalPrice;
- property EndGatherQuantity: Double read FEndGatherQuantity;
- property EndGatherTotalPrice: Double read FEndGatherTotalPrice;
- property AddDealQuantity: Double read FAddDealQuantity;
- property AddDealTotalPrice: Double read FAddGatherTotalPrice;
- property AddQcQuantity: Double read FAddQcQuantity;
- property AddQcTotalPrice: Double read FAddQcTotalPrice;
- property AddGatherQuantity: Double read FAddGatherQuantity;
- property AddGatherTotalPrice: Double read FAddGatherTotalPrice;
- property DealQuantity: Double read FDealQuantity;
- property DealTotalPrice: Double read FDealTotalPrice;
- property BGLQuantity: Double read FBGLQuantity;
- property BGLTotalPrice: Double read FBGLTotalPrice;
- // ---------- Calculate --------------
- property Deal_BGLQuantity: Double read FDeal_BGLQuantity;
- property Deal_BGLTotalPrice: Double read FDeal_BGLTotalPrice;
- property Deal_BGLPercent: Double read FDeal_BGLPercent;
- // -----------------------------------
- property DetailGclCount: Integer read GetDetailGclCount;
- property DetailGcl[AIndex: Integer]: TDetailGclNode read GetDetailGcl;
- property DetailDealCount: Integer read GetDetailDealCount;
- property DetailDeal[AIndex: Integer]: TDetailDealNode read GetDetailDeal;
- property DetailBGLCount: Integer read GetDetailBGLCount;
- property DetailBGL[AIndex: Integer]: TDetailBGLNode read GetDetailBGL;
- end;
- TGclGatherModel = class
- private
- FProjectData: TObject;
- FBillsTree: TBillsIDTree;
- FGatherDeal: Boolean;
- FGatherBGL: Boolean;
- FGcls: TList;
- FNewGclID: Integer;
- FNewDetailGclID: Integer;
- FNewDetailDealID: Integer;
- FNewDetailBGLID: Integer;
- FWriteGatherData: TGatherDataWriteEvent;
- procedure BeginGather;
- procedure EndGather;
- function FindGclNode(const AB_Code, AName, AUnits: string; APrice: Double): TGclNode;
- function NewGclNode(const AB_Code, AName, AUnits: string; APrice: Double): TGclNode;
- function GetGclNode(const AB_Code, AName, AUnits: string; APrice: Double): TGclNode; overload;
- function GetGclNode(ARec: TBillsRecord): TGclNode; overload;
- procedure AddBillsNode(ANode: TBillsIDTreeNode);
- procedure GatherBillsData;
- procedure GatherDealData;
- procedure GatherBGLData;
- procedure CalculateAll;
- function GetNewDetailBGLID: Integer;
- function GetNewDetailDealID: Integer;
- function GetNewDetailGclID: Integer;
- public
- constructor Create(AProjectData: TObject);
- destructor Destroy; override;
- procedure Execute;
- property GatherDeal: Boolean read FGatherDeal write FGatherDeal;
- property GatherBGL: Boolean read FGatherBGL write FGatherBGL;
- property NewDetailGclID: Integer read GetNewDetailGclID;
- property NewDetailDealID: Integer read GetNewDetailDealID;
- property NewDetailBGLID: Integer read GetNewDetailBGLID;
- // 在使用汇总模型的数据单元创建数据库写入方法,并赋值,否则汇总数据不写入
- property WriteGatherData: TGatherDataWriteEvent read FWriteGatherData write FWriteGatherData;
- end;
- implementation
- uses
- ZhAPI, SysUtils, ProjectData, UtilMethods, sdDB, sdIDTree, BGLDm, DB,
- Math;
- { TGclGatherModel }
- procedure TGclGatherModel.AddBillsNode(ANode: TBillsIDTreeNode);
- function GetFirstXmjParent: TBillsIDTreeNode;
- begin
- Result := ANode;
- while Assigned(Result) and (Result.Rec.B_Code.AsString <> '') do
- Result := TBillsIDTreeNode(Result.Parent);
- end;
- function GetPegNode(ALeafXmj: TBillsIDTreeNode): TBillsIDTreeNode;
- begin
- Result := nil;
- if not Assigned(ALeafXmj) then Exit;
- if CheckPeg(ALeafXmj.Rec.Name.AsString) then
- Result := ANode
- else
- Result := GetPegNode(TBillsIDTreeNode(ALeafXmj.Parent));
- end;
- var
- vGclNode: TGclNode;
- vDetailGclNode: TDetailGclNode;
- vLeafXmj, vPeg: TBillsIDTreeNode;
- begin
- vGclNode := GetGclNode(ANode.Rec);
- vDetailGclNode := vGclNode.AddDetailGcl(NewDetailGclID);
- vDetailGclNode.BillsID := ANode.ID;
- vDetailGclNode.TreeSerialNo := ANode.MajorIndex;
- vDetailGclNode.Quantity := ANode.Rec.Quantity.AsFloat;
- vDetailGclNode.TotalPrice := ANode.Rec.TotalPrice.AsFloat;
- if Assigned(ANode.StageRec) then
- begin
- vDetailGclNode.CurDealQuantity := ANode.StageRec.DealQuantity.AsFloat;
- vDetailGclNode.CurDealTotalPrice := ANode.StageRec.DealTotalPrice.AsFloat;
- vDetailGclNode.CurQcQuantity := ANode.StageRec.QcQuantity.AsFloat;
- vDetailGclNode.CurQcTotalPrice := ANode.StageRec.QcTotalPrice.AsFloat;
- vDetailGclNode.CurGatherQuantity := ANode.StageRec.GatherQuantity.AsFloat;
- vDetailGclNode.CurGatherTotalPrice := ANode.StageRec.GatherTotalPrice.AsFloat;
- vDetailGclNode.PreDealQuantity := ANode.StageRec.PreDealQuantity.AsFloat;
- vDetailGclNode.PreDealTotalPrice := ANode.StageRec.PreDealTotalPrice.AsFloat;
- vDetailGclNode.PreQcQuantity := ANode.StageRec.PreQcQuantity.AsFloat;
- vDetailGclNode.PreQcTotalPrice := ANode.StageRec.PreQcTotalPrice.AsFloat;
- vDetailGclNode.PreGatherQuantity := ANode.StageRec.PreGatherQuantity.AsFloat;
- vDetailGclNode.PreGatherTotalPrice := ANode.StageRec.PreGatherTotalPrice.AsFloat;
- vDetailGclNode.EndDealQuantity := ANode.StageRec.EndDealQuantity.AsFloat;
- vDetailGclNode.EndDealTotalPrice := ANode.StageRec.EndDealTotalPrice.AsFloat;
- vDetailGclNode.EndQcQuantity := ANode.StageRec.EndQcQuantity.AsFloat;
- vDetailGclNode.EndQcTotalPrice := ANode.StageRec.EndQcTotalPrice.AsFloat;
- vDetailGclNode.EndGatherQuantity := ANode.StageRec.EndGatherQuantity.AsFloat;
- vDetailGclNode.EndGatherTotalPrice := ANode.StageRec.EndGatherTotalPrice.AsFloat;
- vDetailGclNode.PM_PreTotalPrice := ANode.StageRec.PM_PreTotalPrice.AsFloat;
- vDetailGclNode.PM_TotalPrice := ANode.StageRec.PM_TotalPrice.AsFloat;
- end;
- vDetailGclNode.AddDealQuantity := ANode.Rec.AddDealQuantity.AsFloat;
- vDetailGclNode.AddDealTotalPrice := ANode.Rec.AddDealTotalPrice.AsFloat;
- vDetailGclNode.AddQcQuantity := ANode.Rec.AddQcQuantity.AsFloat;
- vDetailGclNode.AddQcTotalPrice := ANode.Rec.AddQcTotalPrice.AsFloat;
- vDetailGclNode.AddGatherQuantity := ANode.Rec.AddGatherQuantity.AsFloat;
- vDetailGclNode.AddGatherTotalPrice := ANode.Rec.AddGatherTotalPrice.AsFloat;
- vLeafXmj := GetFirstXmjParent;
- vPeg := GetPegNode(vLeafXmj);
- vDetailGclNode.AddPosData(vLeafXmj, vPeg);
- end;
- procedure TGclGatherModel.BeginGather;
- begin
- FGcls := TList.Create;
- end;
- procedure TGclGatherModel.CalculateAll;
- var
- iGcl: Integer;
- begin
- for iGcl := 0 to FGcls.Count - 1 do
- TGclNode(FGcls.Items[iGcl]).Calculate;
- end;
- constructor TGclGatherModel.Create(AProjectData: TObject);
- begin
- FProjectData := AProjectData;
- FBillsTree := TProjectData(FProjectData).BillsMeasureData.BillsMeasureTree;
- FGatherDeal := False;
- FGatherBGL := False;
- end;
- destructor TGclGatherModel.Destroy;
- begin
- inherited;
- end;
- procedure TGclGatherModel.EndGather;
- begin
- ClearObjects(FGcls);
- FGcls.Free;
- end;
- procedure TGclGatherModel.Execute;
- begin
- BeginGather;
- try
- GatherBillsData;
- GatherDealData;
- GatherBGLData;
- CalculateAll;
- if Assigned(FWriteGatherData) then
- FWriteGatherData(FGcls);
- finally
- EndGather;
- end;
- end;
- function TGclGatherModel.FindGclNode(const AB_Code, AName, AUnits: string;
- APrice: Double): TGclNode;
- var
- i: Integer;
- vGcl: TGclNode;
- begin
- Result := nil;
- for i := 0 to FGcls.Count - 1 do
- begin
- vGcl := TGclNode(FGcls.Items[i]);
- if SameText(vGcl.B_Code, TrimRight(AB_Code)) and
- SameText(vGcl.Name, TrimRight(AName)) and
- SameText(vGcl.Units, TrimRight(AUnits)) and
- (abs(vGcl.Price - APrice) < 0.001) then
- begin
- Result := vGcl;
- Break;
- end;
- end;
- end;
- procedure TGclGatherModel.GatherBGLData;
- var
- vGclNode: TGclNode;
- DetailBGL: TDetailBGLNode;
- begin
- if not FGatherBGL then Exit;
- with TProjectData(FProjectData).BGLData do
- begin
- cdsBGBills.First;
- while not cdsBGBills.Eof do
- begin
- vGclNode := GetGclNode(cdsBGBillsB_Code.AsString, cdsBGBillsName.AsString,
- cdsBGBillsUnits.AsString, cdsBGBillsPrice.AsFloat);
- if cdsBGL.FindKey([cdsBGBillsBGID.AsInteger]) then
- begin
- DetailBGL := vGclNode.AddDetailBGL(NewDetailBGLID);
- DetailBGL.BGBillsID := cdsBGBillsID.AsInteger;
- DetailBGL.BGLCode := cdsBGLCode.AsString;
- DetailBGL.BGLName := cdsBGLName.AsString;
- DetailBGL.BGLApprovalCode := cdsBGLApprovalCode.AsString;
- DetailBGL.BGLDrawingCode := cdsBGLDrawingCode.AsString;
- DetailBGL.BGLID := cdsBGBillsBGID.AsInteger;
- DetailBGL.Quantity := cdsBGBillsQuantity.AsFloat;
- DetailBGL.TotalPrice := cdsBGBillsTotalPrice.AsFloat;
- end;
- end;
- end;
- end;
- procedure TGclGatherModel.GatherBillsData;
- var
- i: Integer;
- vNode: TBillsIDTreeNode;
- begin
- for i := 0 to FBillsTree.Count - 1 do
- begin
- vNode := TBillsIDTreeNode(FBillsTree.Items[i]);
- if not vNode.HasChildren and (vNode.Rec.B_Code.AsString <> '') then
- AddBillsNode(vNode);
- end;
- end;
- procedure TGclGatherModel.GatherDealData;
- var
- vGclNode: TGclNode;
- vDetailDeal: TDetailDealNode;
- iDeal: Integer;
- Rec: TsdDataRecord;
- begin
- if not FGatherDeal then Exit;
- with TProjectData(FProjectData).DealBillsData do
- for iDeal := 0 to sddDealBills.RecordCount - 1 do
- begin
- Rec := sddDealBills.Records[iDeal];
- vGclNode := GetGclNode(Rec.ValueByName('B_Code').AsString, Rec.ValueByName('Name').AsString,
- Rec.ValueByName('Units').AsString, Rec.ValueByName('Price').AsFloat);
- vDetailDeal := vGclNode.AddDetailDeal(NewDetailDealID);
- vDetailDeal.Quantity := Rec.ValueByName('Quantity').AsFloat;
- vDetailDeal.TotalPrice := Rec.ValueByName('TotalPrice').AsFloat;
- end;
- end;
- function TGclGatherModel.GetGclNode(ARec: TBillsRecord): TGclNode;
- begin
- Result := GetGclNode(ARec.B_Code.AsString, ARec.Name.AsString,
- ARec.Units.AsString, ARec.Price.AsFloat);
- end;
- function TGclGatherModel.GetGclNode(const AB_Code, AName, AUnits: string;
- APrice: Double): TGclNode;
- begin
- Result := FindGclNode(AB_Code, AName, AUnits, APrice);
- if not Assigned(Result) then
- Result := NewGclNode(AB_Code, AName, AUnits, APrice);
- end;
- function TGclGatherModel.GetNewDetailBGLID: Integer;
- begin
- Result := FNewDetailBGLID;
- Inc(FNewDetailBGLID)
- end;
- function TGclGatherModel.GetNewDetailDealID: Integer;
- begin
- Result := FNewDetailDealID;
- Inc(FNewDetailDealID);
- end;
- function TGclGatherModel.GetNewDetailGclID: Integer;
- begin
- Result := FNewDetailGclID;
- Inc(FNewDetailGclID);
- end;
- function TGclGatherModel.NewGclNode(const AB_Code, AName, AUnits: string;
- APrice: Double): TGclNode;
- begin
- Result := TGclNode.Create(FNewGclID);
- FGcls.Add(Result);
- Result.B_Code := TrimRight(AB_Code);
- Result.Name := TrimRight(AName);
- Result.Units := TrimRight(AUnits);
- Result.Price := APrice;
- Inc(FNewGclID);
- end;
- { TGclNode }
- function TGclNode.AddDetailBGL(AID: Integer): TDetailBGLNode;
- begin
- Result := TDetailBGLNode.Create(AID);
- FDetailBGLs.Add(Result);
- end;
- function TGclNode.AddDetailDeal(AID: Integer): TDetailDealNode;
- begin
- Result := TDetailDealNode.Create(AID);
- FDetailDeals.Add(Result);
- end;
- function TGclNode.AddDetailGcl(AID: Integer): TDetailGclNode;
- begin
- Result := TDetailGclNode.Create(AID);
- FDetailGcls.Add(Result);
- end;
- procedure TGclNode.Calculate;
- begin
- InitCalculate;
- GatherDetailGcl;
- GatherDetailDeal;
- GatherDetailBGL;
- CalculateOther;
- end;
- procedure TGclNode.CalculateOther;
- begin
- FDeal_BGLQuantity := FQuantity + FBGLQuantity;
- FDeal_BGLTotalPrice := FTotalPrice + FBGLTotalPrice;
- if FDeal_BGLTotalPrice <> 0 then
- FDeal_BGLPercent := CommonRoundTo(FEndGatherTotalPrice/FDeal_BGLTotalPrice*100, -2)
- else
- FDeal_BGLPercent := 0;
- end;
- constructor TGclNode.Create(AID: Integer);
- begin
- FID := AID;
- FDetailGcls := TList.Create;
- FDetailDeals := TList.Create;
- FDetailBGLs := TList.Create;
- end;
- destructor TGclNode.Destroy;
- begin
- ClearObjects(FDetailBGLs);
- FDetailBGLs.Free;
- ClearObjects(FDetailDeals);
- FDetailDeals.Free;
- ClearObjects(FDetailGcls);
- FDetailGcls.Free;
- inherited;
- end;
- procedure TGclNode.GatherDetailBGL;
- var
- iBGL: Integer;
- vDetailBGL: TDetailBGLNode;
- begin
- for iBGL := 0 to DetailBGLCount - 1 do
- begin
- vDetailBGL := DetailBGL[iBGL];
- FBGLQuantity := FBGLQuantity + vDetailBGL.Quantity;
- FBGLTotalPrice := FBGLTotalPrice + vDetailBGL.TotalPrice;
- end;
- end;
- procedure TGclNode.GatherDetailDeal;
- var
- iDeal: Integer;
- vDetailDeal: TDetailDealNode;
- begin
- for iDeal := 0 to DetailDealCount - 1 do
- begin
- vDetailDeal := DetailDeal[iDeal];
- FDealQuantity := FDealQuantity + vDetailDeal.Quantity;
- FDealTotalPrice := FDealTotalPrice + vDetailDeal.TotalPrice;
- end;
- end;
- procedure TGclNode.GatherDetailGcl;
- var
- iGcl: Integer;
- vDetailGcl: TDetailGclNode;
- begin
- for iGcl := 0 to DetailGclCount - 1 do
- begin
- vDetailGcl := DetailGcl[iGcl];
- FQuantity := FQuantity + vDetailGcl.Quantity;
- FTotalPrice := FTotalPrice + vDetailGcl.TotalPrice;
- FCurDealQuantity := FCurDealQuantity + vDetailGcl.CurDealQuantity;
- FCurDealTotalPrice := FCurDealTotalPrice + vDetailGcl.CurDealTotalPrice;
- FCurQcQuantity := FCurQcQuantity + vDetailGcl.CurQcQuantity;
- FCurQcTotalPrice := FCurQcTotalPrice + vDetailGcl.CurQcTotalPrice;
- FCurGatherQuantity := FCurGatherQuantity + vDetailGcl.CurGatherQuantity;
- FCurGatherTotalPrice := FCurGatherTotalPrice + vDetailGcl.CurGatherTotalPrice;
- FPreDealQuantity := FPreDealQuantity + vDetailGcl.PreDealQuantity;
- FPreDealTotalPrice := FPreDealTotalPrice + vDetailGcl.PreDealTotalPrice;
- FPreQcQuantity := FPreQcQuantity + vDetailGcl.PreQcQuantity;
- FPreQcTotalPrice := FPreQcTotalPrice + vDetailGcl.PreQcTotalPrice;
- FPreGatherQuantity := FPreGatherQuantity + vDetailGcl.PreGatherQuantity;
- FPreGatherTotalPrice := FPreGatherTotalPrice + vDetailGcl.PreGatherTotalPrice;
- FEndDealQuantity := FEndDealQuantity + vDetailGcl.EndDealQuantity;
- FEndDealTotalPrice := FEndDealTotalPrice + vDetailGcl.EndDealTotalPrice;
- FEndQcQuantity := FEndQcQuantity + vDetailGcl.EndQcQuantity;
- FEndQcTotalPrice := FEndQcTotalPrice + vDetailGcl.EndQcTotalPrice;
- FEndGatherQuantity := FEndGatherQuantity + vDetailGcl.EndGatherQuantity;
- FEndGatherTotalPrice := FEndGatherTotalPrice + vDetailGcl.EndGatherTotalPrice;
- FAddDealQuantity := FAddDealQuantity + vDetailGcl.AddDealQuantity;
- FAddDealTotalPrice := FAddDealTotalPrice + vDetailGcl.AddDealTotalPrice;
- FAddQcQuantity := FAddQcQuantity + vDetailGcl.AddQcQuantity;
- FAddQcTotalPrice := FAddQcTotalPrice + vDetailGcl.AddQcTotalPrice;
- FAddGatherQuantity := FAddGatherQuantity + vDetailGcl.AddGatherQuantity;
- FAddGatherTotalPrice := FAddGatherTotalPrice + vDetailGcl.AddGatherTotalPrice;
- end;
- end;
- function TGclNode.GetDetailBGL(AIndex: Integer): TDetailBGLNode;
- begin
- Result := TDetailBGLNode(FDetailBGLs.Items[AIndex]);
- end;
- function TGclNode.GetDetailBGLCount: Integer;
- begin
- Result := FDetailBGLs.Count;
- end;
- function TGclNode.GetDetailDeal(AIndex: Integer): TDetailDealNode;
- begin
- Result := TDetailDealNode(FDetailDeals.Items[AIndex]);
- end;
- function TGclNode.GetDetailDealCount: Integer;
- begin
- Result := FDetailDeals.Count;
- end;
- function TGclNode.GetDetailGcl(AIndex: Integer): TDetailGclNode;
- begin
- Result := TDetailGclNode(FDetailGcls.Items[AIndex]);
- end;
- function TGclNode.GetDetailGclCount: Integer;
- begin
- Result := FDetailGcls.Count;
- end;
- procedure TGclNode.InitCalculate;
- begin
- FQuantity := 0;
- FTotalPrice := 0;
- FCurDealQuantity := 0;
- FCurDealTotalPrice := 0;
- FCurQcQuantity := 0;
- FCurQcTotalPrice := 0;
- FCurGatherQuantity := 0;
- FCurGatherTotalPrice := 0;
- FPreDealQuantity := 0;
- FPreDealTotalPrice := 0;
- FPreQcQuantity := 0;
- FPreQcTotalPrice := 0;
- FPreGatherQuantity := 0;
- FPreGatherTotalPrice := 0;
- FEndDealQuantity := 0;
- FEndDealTotalPrice := 0;
- FEndQcQuantity := 0;
- FEndQcTotalPrice := 0;
- FEndGatherQuantity := 0;
- FEndGatherTotalPrice := 0;
- FAddDealQuantity := 0;
- FAddDealTotalPrice := 0;
- FAddQcQuantity := 0;
- FAddQcTotalPrice := 0;
- FAddGatherQuantity := 0;
- FAddGatherTotalPrice := 0;
- FDealQuantity := 0;
- FDealTotalPrice := 0;
- FBGLQuantity := 0;
- FBGLTotalPrice := 0;
- FDeal_BGLQuantity := 0;
- FDeal_BGLTotalPrice := 0;
- FDeal_BGLPercent := 0;
- end;
- procedure TGclNode.SetB_Code(const Value: string);
- begin
- FB_Code := Value;
- FIndexCode := B_CodeToIndexCode(FB_Code);
- end;
- { TDetailGclNode }
- procedure TDetailGclNode.AddPosData(ALeafXmj, APeg: TBillsIDTreeNode);
- function GetPegName: string;
- begin
- if Assigned(APeg) then
- Result := APeg.Rec.Name.AsString
- else
- Result := '';
- end;
- // 取树结构的第ALevel层节点的名称(level从0开始)
- function GetNameByLevel(ANode: TBillsIDTreeNode; ALevel: Integer): string;
- begin
- Result := '';
- if not Assigned(ANode) then Exit;
- if ANode.Level = ALevel then
- Result := ANode.Rec.Name.AsString
- else if ANode.Level > ALevel then
- Result := GetNameByLevel(TBillsIDTreeNode(ANode.Parent), ALevel);
- end;
- function GetNameDanWei(ANode: TBillsIDTreeNode): string;
- begin
- // 取树结构的第二层节点的名称
- Result := GetNameByLevel(ANode, 1);
- end;
- // ANode为计量单元节点,APegNode为桩号节点
- function GetNameFenBu(ANode, APegNode: TBillsIDTreeNode): string;
- var
- vCurNode: TBillsIDTreeNode;
- begin
- // 如果计量单元节点的名称为桩号(转化为判断计量单元节点与桩号节点为同一个)
- if not Assigned(APegNode) or (ANode.ID = APegNode.ID) then
- // 取树结构的第三层节点的名称
- Result := GetNameByLevel(ANode, 2)
- // 否则,取桩号节点的子节点的名称
- else
- begin
- vCurNode := ANode;
- while vCurNode.Level > APegNode.Level + 1 do
- vCurNode := TBillsIDTreeNode(vCurNode.Parent);
- Result := vCurNode.Rec.Name.AsString;
- end;
- end;
- // ANode为计量单元节点,APegNode为桩号节点
- function GetNameFenXiang(ANode, APegNode: TBillsIDTreeNode): string;
- var
- iTopLevel: Integer;
- vCurNode: TBillsIDTreeNode;
- begin
- if Assigned(APegNode) then
- begin
- iTopLevel := 3;
- if APegNode.ID <> ANode.ID then
- iTopLevel := APegNode.Level + 2;
- Result := '';
- vCurNode := TBillsIDTreeNode(ANode.Parent);
- while vCurNode.Level >= iTopLevel do
- begin
- Result := vCurNode.Rec.Name.AsString + ';' + Result;
- vCurNode := TBillsIDTreeNode(vCurNode.Parent);
- end;
- end
- else
- Result := GetNameByLevel(ANode, 3);
- end;
- function GetNameUnit(ANode: TBillsIDTreeNode): string;
- begin
- Result := ANode.Rec.Name.AsString;
- end;
- function GetDrawingCode(ANode: TBillsIDTreeNode): string;
- begin
- Result := '';
- if not Assigned(ANode) then Exit;
- Result := ANode.Rec.DrawingCode.AsString;
- if Result = '' then
- Result := GetDrawingCode(TBillsIDTreeNode(ANode.Parent));
- end;
- function GetPosition(ANode, APegNode: TBillsIDTreeNode): string;
- begin
- // 如果计量单元节点的名称为桩号(转化为判断计量单元节点与桩号节点为同一个)
- if not Assigned(APegNode) or (ANode.ID = APegNode.ID) then
- // 取分部工程
- Result := GetNameFenXiang(ANode, APegNode)
- // 反之,取分项工程+计量单元
- else
- Result := GetNameFenXiang(ANode, APegNode) + GetNameUnit(ANode);
- end;
- begin
- if not Assigned(ALeafXmj) then Exit;
- FLeafXmjID := ALeafXmj.ID;
- FXmjCode := ALeafXmj.Rec.Code.AsString;
- FXmjName := ALeafXmj.Rec.Name.AsString;
- FXmjUnits := ALeafXmj.Rec.Units.AsString;
- FPeg := GetPegName;
- FNameDanWei := GetNameDanWei(ALeafXmj);
- FNameFenBu := GetNameFenBu(ALeafXmj, APeg);
- FNameFenXiang := GetNameFenXiang(ALeafXmj, APeg);
- FNameUnit := GetNameUnit(ALeafXmj);
- FPosition := GetPosition(ALeafXmj, APeg);
- FDrawingCode := GetDrawingCode(ALeafXmj);
- end;
- constructor TDetailGclNode.Create(AID: Integer);
- begin
- FID := AID;
- end;
- { TDetailBGLNode }
- constructor TDetailBGLNode.Create(AID: Integer);
- begin
- FID := AID;
- end;
- { TDetailDealNode }
- constructor TDetailDealNode.Create(AID: Integer);
- begin
- FID := AID;
- end;
- end.
|