Measure/DataModules/ReportMemoryDm/rmGclBillsPlaneDm.pas

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.