unit rmGclBillsPlaneDm; // 0号台账平面表 interface uses SysUtils, Classes, ProjectData, DB, DBClient, sdIDTree; type TGclBillNode = class private FB_Code: string; FName: string; FUnits: string; FQuantity: Double; public 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 Quantity: Double read FQuantity write FQuantity; end; TLastXmjNode = class private FGclBills: TList; FCode: string; FName: string; FUnits: string; FPeg: string; FParentName: string; FDrawingCode: string; function GetBeginPeg: string; function GetEndPeg: string; function GetLastCode: string; function GetPreCode: string; procedure SetPeg(const Value: string); public constructor Create; destructor Destroy; override; function AddGclBillNode: TGclBillNode; property Code: string read FCode write FCode; property PreCode: string read GetPreCode; property LastCode: string read GetLastCode; property Name: string read FName write FName; property Units: string read FUnits write FUnits; property Peg: string read FPeg write SetPeg; property BeginPeg: string read GetBeginPeg; property EndPeg: string read GetEndPeg; property ParentName: string read FParentName write FParentName; property DrawingCode: string read FDrawingCode write FDrawingCode; end; TrmGclBillsPlaneData = class(TDataModule) cdsGclBillsPlane: TClientDataSet; cdsGclBillsPlanePreCode: TStringField; cdsGclBillsPlaneLastCode: TStringField; cdsGclBillsPlaneCode: TStringField; cdsGclBillsPlaneXmjName: TWideStringField; cdsGclBillsPlaneXmjUnits: TWideStringField; cdsGclBillsPlanePeg: TWideStringField; cdsGclBillsPlaneBeginPeg: TWideStringField; cdsGclBillsPlaneEndPeg: TWideStringField; cdsGclBillsPlaneNameBuWei: TWideStringField; cdsGclBillsPlaneB_Code: TStringField; cdsGclBillsPlaneName: TWideStringField; cdsGclBillsPlaneUnits: TWideStringField; cdsGclBillsPlaneQuantity: TFloatField; cdsGclBillsPlaneDrawingCode: TWideStringField; private FLastXmjs: TList; FProjectData: TProjectData; procedure AddGclBill(ANode: TsdIDTreeNode; ALastXmj: TLastXmjNode); procedure AddGclBills(ANode:TsdIDTreeNode; ALastXmj: TLastXmjNode); function GetPegNode(ANode: TsdIDTreeNode): TsdIDTreeNode; function CheckLastXmj(ANode: TsdIDTreeNode): Boolean; procedure AddLastXmj(ANode: TsdIDTreeNode); procedure FilterBills(ANode: TsdIDTreeNode); procedure WriteLastXmj(ALastXmj: TLastXmjNode); procedure WriteData; public function AssignData(AProjectData: TProjectData): TDataSet; end; implementation uses ZhAPI, UtilMethods, sdDB; {$R *.dfm} { TLastXmjNode } function TLastXmjNode.AddGclBillNode: TGclBillNode; begin Result := TGclBillNode.Create; FGclBills.Add(Result); end; constructor TLastXmjNode.Create; begin FGclBills := TList.Create; end; destructor TLastXmjNode.Destroy; begin ClearObjects(FGclBills); FGclBills.Free; inherited; end; function TLastXmjNode.GetBeginPeg: string; var iPos: Integer; begin iPos := Pos('~', FPeg); Result := Copy(FPeg, 1, iPos-1); end; function TLastXmjNode.GetEndPeg: string; var iPos: Integer; begin iPos := Pos('~', FPeg); Result := Copy(FPeg, iPos + 1, Length(FPeg) - iPos); end; function TLastXmjNode.GetLastCode: string; begin Result := GetLastSetmentOfCode(FCode); end; function TLastXmjNode.GetPreCode: string; begin Result := GetPrefixOfCode(FCode); end; procedure TLastXmjNode.SetPeg(const Value: string); begin FPeg := StringReplace(Value, '~', '~', [rfReplaceAll]); end; { TrmGclBillsPlaneData } procedure TrmGclBillsPlaneData.AddGclBill(ANode: TsdIDTreeNode; ALastXmj: TLastXmjNode); var GclBill: TGclBillNode; begin if ANode.Rec.ValueByName('B_Code').AsString = '' then Exit; GclBill := ALastXmj.AddGclBillNode; GclBill.B_Code := ANode.Rec.ValueByName('B_Code').AsString; GclBill.Name := ANode.Rec.ValueByName('Name').AsString; GclBill.Units := ANode.Rec.ValueByName('Units').AsString; GclBill.Quantity := ANode.Rec.ValueByName('Quantity').AsFloat; end; procedure TrmGclBillsPlaneData.AddGclBills(ANode: TsdIDTreeNode; ALastXmj: TLastXmjNode); begin if not Assigned(ANode) then Exit; if not ANode.HasChildren then AddGclBill(ANode, ALastXmj); AddGclBills(ANode.FirstChild, ALastXmj); AddGclBills(ANode.NextSibling, ALastXmj); end; procedure TrmGclBillsPlaneData.AddLastXmj(ANode: TsdIDTreeNode); var LastXmj: TLastXmjNode; vPeg: TsdIDTreeNode; begin if not Assigned(ANode) then Exit; LastXmj := TLastXmjNode.Create; FLastXmjs.Add(LastXmj); LastXmj.Code := ANode.Rec.ValueByName('Code').AsString; LastXmj.Name := ANode.Rec.ValueByName('Name').AsString; LastXmj.Units := ANode.Rec.ValueByName('Units').AsString; vPeg := GetPegNode(ANode); if Assigned(vPeg) then LastXmj.Peg := vPeg.Rec.ValueByName('Name').AsString; if Assigned(ANode.Parent) then LastXmj.ParentName := ANode.Parent.Rec.ValueByName('Name').AsString; LastXmj.DrawingCode := ANode.Rec.ValueByName('DrawingCode').AsString; AddGclBills(ANode.FirstChild, LastXmj); end; function TrmGclBillsPlaneData.AssignData( AProjectData: TProjectData): TDataSet; begin FLastXmjs := TList.Create; cdsGclBillsPlane.Active := True; cdsGclBillsPlane.EmptyDataSet; try FProjectData := AProjectData; FilterBills(FProjectData.BillsCompileData.BillsCompileTree.FirstNode); WriteData; finally ClearObjects(FLastXmjs); FLastXmjs.Free; Result := cdsGclBillsPlane; end; end; function TrmGclBillsPlaneData.CheckLastXmj(ANode: TsdIDTreeNode): Boolean; function IsXmj: Boolean; begin Result := ANode.Rec.ValueByName('Code').AsString <> ''; end; function HasGcl: Boolean; var vChild: TsdIDTreeNode; begin Result := False; vChild := ANode.FirstChild; while not Result and Assigned(vChild) do begin if (vChild.Rec.ValueByName('Code').AsString = '') and (vChild.Rec.ValueByName('B_Code').AsString <> '') then Result := True; vChild := vChild.NextSibling; end; end; begin // 报表数据的主体应是工程量清单,故最底层项目节的判断为,其下含有工程量清单则为项目节 Result := IsXmj and HasGcl; end; procedure TrmGclBillsPlaneData.FilterBills(ANode: TsdIDTreeNode); begin if not Assigned(ANode) then Exit; if CheckLastXmj(ANode) then AddLastXmj(ANode); FilterBills(ANode.FirstChild); FilterBills(ANode.NextSibling); end; function TrmGclBillsPlaneData.GetPegNode( ANode: TsdIDTreeNode): TsdIDTreeNode; begin Result := nil; if not Assigned(ANode) then Exit; if CheckPeg(ANode.Rec.ValueByName('Name').AsString) then Result := ANode else Result := GetPegNode(ANode.Parent); end; procedure TrmGclBillsPlaneData.WriteData; var i: Integer; begin for i := 0 to FLastXmjs.Count - 1 do WriteLastXmj(TLastXmjNode(FLastXmjs.Items[i])); end; procedure TrmGclBillsPlaneData.WriteLastXmj(ALastXmj: TLastXmjNode); var i: Integer; GclBill: TGclBillNode; begin for i := 0 to ALastXmj.FGclBills.Count - 1 do begin GclBill := TGclBillNode(ALastXmj.FGclBills.Items[i]); cdsGclBillsPlane.Append; cdsGclBillsPlanePreCode.AsString := ALastXmj.PreCode; cdsGclBillsPlaneLastCode.AsString := ALastXmj.LastCode; cdsGclBillsPlaneCode.AsString := ALastXmj.Code; cdsGclBillsPlaneXmjName.AsString := ALastXmj.Name; cdsGclBillsPlaneXmjUnits.AsString := ALastXmj.Units; cdsGclBillsPlanePeg.AsString := ALastXmj.Peg; cdsGclBillsPlaneBeginPeg.AsString := ALastXmj.BeginPeg; cdsGclBillsPlaneEndPeg.AsString := ALastXmj.EndPeg; cdsGclBillsPlaneNameBuWei.AsString := ALastXmj.ParentName; cdsGclBillsPlaneDrawingCode.AsString := ALastXmj.DrawingCode; cdsGclBillsPlaneB_Code.AsString := GclBill.B_Code; cdsGclBillsPlaneName.AsString := GclBill.Name; cdsGclBillsPlaneUnits.AsString := GclBill.Units; cdsGclBillsPlaneQuantity.AsFloat := GclBill.Quantity; cdsGclBillsPlane.Post; end; end; end.