unit ProjGatherTree; interface uses CacheTree, Classes, CalcData; type TProjGatherTreeNode = class(TCacheNode) private FCode: string; FB_Code: string; FName: string; FUnits: string; FPrice: Double; FSerialNo: Integer; FXiangCode: string; FMuCode: string; FJieCode: string; FXiMuCode: string; FIndexCode: string; FChapterParentID: Integer; FGatherCalc: TProjCalc; FProjs: TList; function GetProjCount: Integer; function GetProj(AIndex: Integer): TProjCalc; function GetChapterParentID: Integer; function GetLevel: Integer; public constructor Create(ACacheTree: TCacheTree; AID: Integer; AProjCount: Integer); destructor Destroy; override; procedure InitTotalPrice_Rc; procedure UpdateTotalPrice_Rc(ANode: TProjGatherTreeNode); procedure CalcTotalPrice_Rc; procedure InitCalcData; procedure AddCalcData(ANode: TProjGatherTreeNode); procedure MinusCalcData(ANode: TProjGatherTreeNode); property Code: string read FCode write FCode; property B_Code: string read FB_Code write FB_Code; property Name: string read FName write FName; property Units: string read FUnits write FUnits; property Price: Double read FPrice write FPrice; property SerialNo: Integer read FSerialNo write FSerialNo; property XiangCode: string read FXiangCode write FXiangCode; property MuCode: string read FMuCode write FMuCode; property JieCode: string read FJieCode write FJieCode; property XiMuCode: string read FXiMuCode write FXiMuCode; property IndexCode: string read FIndexCode write FIndexCode; property Level: Integer read GetLevel; property ChapterParentID: Integer read GetChapterParentID; property GatherCalc: TProjCalc read FGatherCalc; property ProjCount: Integer read GetProjCount; property Proj[AIndex: Integer]: TProjCalc read GetProj; end; TProjGatherTree = class(TCacheTree) private FProjCount: Integer; FFixedIDNodes: TList; FGatherNode: TProjGatherTreeNode; FSerialNo: Integer; function GetNewNode(AFixedID: Integer = -1): TProjGatherTreeNode; procedure Calculate(ANode: TProjGatherTreeNode); procedure CalcGatherNode; public constructor Create(AProjCount: Integer); destructor Destroy; override; function AddNode(AParent, ANextSibling: TProjGatherTreeNode; AFixedID: Integer = -1): TProjGatherTreeNode; function FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code, AName: string; APrice: Double): TProjGatherTreeNode; overload; function FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code: string; APrice: Double): TProjGatherTreeNode; overload; function FindNode(AParent: TProjGatherTreeNode; const AName: string; APrice: Double): TProjGatherTreeNode; overload; function FindNode(AFixedID: Integer): TProjGatherTreeNode; overload; function FindNextSibling(AParent: TProjGatherTreeNode; const ACode, AB_Code: string): TProjGatherTreeNode; procedure CalculateAll; procedure SaveDebugFile(const AFileName: string); property GatherNode: TProjGatherTreeNode read FGatherNode; end; implementation uses ZhAPI, SysUtils, ConditionalDefines; { TProjGatherTreeNode } procedure TProjGatherTreeNode.AddCalcData(ANode: TProjGatherTreeNode); var iProj: Integer; begin GatherCalc.AddCalcData(ANode.GatherCalc); for iProj := 0 to ProjCount - 1 do Proj[iProj].AddCalcData(ANode.Proj[iProj]); end; procedure TProjGatherTreeNode.CalcTotalPrice_Rc; var iProj: Integer; begin GatherCalc.CalcTotalPrice_Rc(Price); for iProj := 0 to ProjCount - 1 do Proj[iProj].CalcTotalPrice_Rc(Price); end; constructor TProjGatherTreeNode.Create(ACacheTree: TCacheTree; AID: Integer; AProjCount: Integer); var i: Integer; ProjCalc: TProjCalc; begin inherited Create(ACacheTree, AID); FGatherCalc := TProjCalc.Create; FProjs := TList.Create; for i := 0 to AProjCount - 1 do begin ProjCalc := TProjCalc.Create; FProjs.Add(ProjCalc); end; end; destructor TProjGatherTreeNode.Destroy; begin FGatherCalc.free; ClearObjects(FProjs); FProjs.Free; inherited; end; function TProjGatherTreeNode.GetChapterParentID: Integer; var vNode: TProjGatherTreeNode; begin Result := -1; if Self.Level > 2 then begin vNode := TProjGatherTreeNode(Self.Parent); while vNode.Level > 2 do vNode := TProjGatherTreeNode(vNode.Parent); Result := vNode.ID end; end; function TProjGatherTreeNode.GetLevel: Integer; begin if Assigned(Parent) and (Parent.ID <> -1) then Result := TProjGatherTreeNode(Parent).Level + 1 else Result := 1; end; function TProjGatherTreeNode.GetProj(AIndex: Integer): TProjCalc; begin Result := TProjCalc(FProjs.Items[AIndex]); end; function TProjGatherTreeNode.GetProjCount: Integer; begin Result := FProjs.Count; end; procedure TProjGatherTreeNode.InitCalcData; var iProj: Integer; begin GatherCalc.InitCalcData; for iProj := 0 to ProjCount - 1 do Proj[iProj].InitCalcData; end; procedure TProjGatherTreeNode.InitTotalPrice_Rc; var iProj: Integer; begin GatherCalc.InitTotalPrice_Rc; for iProj := 0 to ProjCount - 1 do Proj[iProj].InitTotalPrice_Rc; end; procedure TProjGatherTreeNode.MinusCalcData(ANode: TProjGatherTreeNode); var iProj: Integer; begin GatherCalc.MinusCalcData(ANode.GatherCalc); for iProj := 0 to ProjCount - 1 do Proj[iProj].MinusCalcData(ANode.Proj[iProj]); end; procedure TProjGatherTreeNode.UpdateTotalPrice_Rc(ANode: TProjGatherTreeNode); var iProj: Integer; begin GatherCalc.UpdateTotalPrice_Rc(ANode.GatherCalc); for iProj := 0 to ANode.ProjCount - 1 do Proj[iProj].UpdateTotalPrice_Rc(ANode.Proj[iProj]); end; { TProjGatherTree } procedure TProjGatherTree.Calculate(ANode: TProjGatherTreeNode); var iChild: Integer; vChild: TProjGatherTreeNode; begin ANode.SerialNo := FSerialNo; Inc(FSerialNo); ANode.InitTotalPrice_Rc; if ANode.Children.Count > 0 then begin for iChild := 0 to ANode.Children.Count - 1 do begin vChild := TProjGatherTreeNode(ANode.Children.Items[iChild]); Calculate(vChild); ANode.UpdateTotalPrice_Rc(vChild); end; end else ANode.CalcTotalPrice_Rc; end; procedure TProjGatherTree.CalculateAll; var vNode: TProjGatherTreeNode; begin FSerialNo := 1; vNode := TProjGatherTreeNode(FirstNode); while Assigned(vNode) do begin Calculate(vNode); vNode := TProjGatherTreeNode(vNode.NextSibling); end; CalcGatherNode; end; constructor TProjGatherTree.Create(AProjCount: Integer); begin inherited Create; FProjCount := AProjCount; FFixedIDNodes := TList.Create; FGatherNode := TProjGatherTreeNode.Create(nil, -2, AProjCount); end; destructor TProjGatherTree.Destroy; begin FGatherNode.Free; FFixedIDNodes.Free; inherited; end; function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code, AName: string; APrice: Double): TProjGatherTreeNode; var iChild: Integer; vChild: TProjGatherTreeNode; begin Result := nil; for iChild := 0 to AParent.Children.Count - 1 do begin vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]); if (vChild.Code = ACode) and (vChild.B_Code = AB_Code) and (vChild.Name = AName) and (abs(vChild.Price - APrice) < 0.00001) then begin Result := vChild; Break; end; end; end; function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code: string; APrice: Double): TProjGatherTreeNode; var iChild: Integer; vChild: TProjGatherTreeNode; begin Result := nil; for iChild := 0 to AParent.Children.Count - 1 do begin vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]); if (vChild.Code = ACode) and (vChild.B_Code = AB_Code) and (abs(vChild.Price - APrice) < 0.00001) then begin Result := vChild; Break; end; end; end; function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode; const AName: string; APrice: Double): TProjGatherTreeNode; var iChild: Integer; vChild: TProjGatherTreeNode; begin Result := nil; for iChild := 0 to AParent.Children.Count - 1 do begin vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]); if (vChild.Name = AName) and (abs(vChild.Price - APrice) < 0.00001) then begin Result := vChild; Break; end; end; end; function TProjGatherTree.FindNextSibling(AParent: TProjGatherTreeNode; const ACode, AB_Code: string): TProjGatherTreeNode; var vNext: TProjGatherTreeNode; sCodeID, sCodeID2, sB_CodeID, sB_CodeID2: string; begin Result := nil; if Assigned(AParent) then vNext := TProjGatherTreeNode(AParent.FirstChild) else vNext := TProjGatherTreeNode(Root.FirstChild); if (ACode = '') and (AB_Code = '') then Exit; sCodeID := ConvertDigitCode(ACode, 3, '-'); sB_CodeID := ConvertDigitCode(AB_Code, 4, '-'); while Assigned(vNext) do begin sCodeID2 := ConvertDigitCode(vNext.Code, 3, '-'); sB_CodeID2 := ConvertDigitCode(vNext.B_Code, 4, '-'); if sCodeID < sCodeID2 then begin Result := vNext; Break; end else if sB_CodeID < sB_CodeID2 then begin Result := vNext; Break; end; vNext := TProjGatherTreeNode(vNext.NextSibling); end; end; function TProjGatherTree.FindNode(AFixedID: Integer): TProjGatherTreeNode; var i: Integer; vNode: TProjGatherTreeNode; begin Result := nil; for i := 0 to FFixedIDNodes.Count - 1 do begin vNode := TProjGatherTreeNode(FFixedIDNodes.Items[i]); if vNode.ID = AFixedID then begin Result := vNode; Break; end; end; end; function TProjGatherTree.GetNewNode(AFixedID: Integer): TProjGatherTreeNode; begin if AFixedID <> -1 then begin Result := TProjGatherTreeNode.Create(Self, AFixedID, FProjCount); FFixedIDNodes.Add(Result); end else Result := TProjGatherTreeNode.Create(Self, GetNewNodeID, FProjCount); CacheNodes.Add(Result); end; function TProjGatherTree.AddNode(AParent, ANextSibling: TProjGatherTreeNode; AFixedID: Integer): TProjGatherTreeNode; begin Result := GetNewNode(AFixedID); if Assigned(ANextSibling) then ANextSibling.InsertPreSibling(Result) else if Assigned(AParent) then AParent.InsertChild(Result) else Root.InsertChild(Result); end; procedure TProjGatherTree.SaveDebugFile(const AFileName: string); var sgs: TStringList; i: Integer; vNode: TProjGatherTreeNode; begin sgs := TStringList.Create; try for i := 0 to CacheNodes.Count - 1 do begin vNode := TProjGatherTreeNode(CacheNodes.Items[i]); sgs.Add(Format('ID: %d; Code: %s; B_Code: %s; Name: %s', [vNode.ID, vNode.Code, vNode.B_Code, vNode.Name])); end; sgs.SaveToFile(AFileName); finally sgs.Free; end; end; procedure TProjGatherTree.CalcGatherNode; procedure AddGatherCalc(AID: Integer); var vNode: TProjGatherTreeNode; begin vNode := FindNode(AID); if Assigned(vNode) then GatherNode.AddCalcData(vNode); end; procedure MinusGatherCalc(AID: Integer); var vNode: TProjGatherTreeNode; begin vNode := FindNode(AID); if Assigned(vNode) then GatherNode.MinusCalcData(vNode); end; begin GatherNode.InitCalcData; // 全国 // 第一部分(1)+第二部分(2)+第三部分(3)+预备费(7)+新增加费用项目(其他费用_广东)(15)-回收金额(16) AddGatherCalc(1); AddGatherCalc(2); AddGatherCalc(3); AddGatherCalc(7); AddGatherCalc(15); MinusGatherCalc(16); // 广东 // 全国的基础上+建设期贷款利息(34)+公路功能以外的项目(9) if _IsGuangDong then begin AddGatherCalc(34); AddGatherCalc(9); end; end; end.