Measure/TenderPartition/tpGatherTree.pas

unit tpGatherTree;
// 实际上可以使用mCacheTree中的ReportCacheTree
// 但此处的树节点更多，使用的清单数据不多，为了便于理解，故重写

interface

uses
  Classes, CacheTree, mDataRecord, ZhAPI, sdDB, sdIDTree;

type
  TtpGatherTreeNode = class(TCacheNode)
  private
    FCode: string;
    FB_Code: string;
    FName: string;
    FUnits: string;
    FPrice: Double;

    FQuantity: Double;
    FTotalPrice: Double;
    FDgnQuantity1: Double;
    FDgnQuantity2: Double;

    FRelaPeg: Boolean;
    FParted: Boolean;
  public
    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 Quantity: Double read FQuantity write FQuantity;
    property TotalPrice: Double read FTotalPrice write FTotalPrice;
    property DgnQuantity1: Double read FDgnQuantity1 write FDgnQuantity1;
    property DgnQuantity2: Double read FDgnQuantity2 write FDgnQuantity2;

    // 节点为桩号/节点的父项为桩号/节点的子项全为桩号
    property RelaPeg: Boolean read FRelaPeg write FRelaPeg;
    property Parted: Boolean read FParted write FParted;
  end;

  TtpGatherTree = class(TCacheTree)
  private
    function SamePrice(APrice1, APrice2: Double): Boolean;

    function GetParentParted(ANode: TtpGatherTreeNode): Boolean;
    procedure CheckNodeParted(ANode: TtpGatherTreeNode);

    function GetParentRelaPeg(ANode: TtpGatherTreeNode): Boolean;
    procedure CheckNodeRelaPeg(ANode: TtpGatherTreeNode);
  protected
    function GetNewNode: TCacheNode; override;
  public
    function FindNode(AParent: TtpGatherTreeNode; ARec: TBillsRecord): TtpGatherTreeNode;
    function FindNextSibling(AParent: TtpGatherTreeNode; ARec: TBillsRecord): TtpGatherTreeNode;

    function AddNode(AParent: TCacheNode; ANextSibling: TCacheNode = nil): TtpGatherTreeNode;

    procedure CalculateAllParent;
    procedure WriteData(ADataSet: TsdDataSet);

    procedure CheckRelaPeg;
    procedure CheckParted;
  end;

implementation

uses SysUtils;

{ TtpGatherTree }

function TtpGatherTree.AddNode(AParent,
  ANextSibling: TCacheNode): TtpGatherTreeNode;
begin
  Result := TtpGatherTreeNode(GetNewNode);
  if Assigned(ANextSibling) then
    ANextSibling.InsertPreSibling(Result)
  else if Assigned(AParent) then
    AParent.InsertChild(Result)
  else
    Root.InsertChild(Result);
end;

procedure TtpGatherTree.CalculateAllParent;

  function GatherChildren(ANode: TtpGatherTreeNode): Double;
  var
    vChild: TtpGatherTreeNode;
  begin
    Result := 0;
    if not Assigned(ANode) then Exit;

    vChild := TtpGatherTreeNode(ANode.FirstChild);
    while Assigned(vChild) do
    begin
      Result := Result + vChild.TotalPrice;
      vChild := TtpGatherTreeNode(vChild.NextSibling);
    end;
  end;

  procedure CalculateParent(ANode: TtpGatherTreeNode);
  begin
    if not Assigned(ANode) or not Assigned(ANode.FirstChild) then Exit;

    CalculateParent(TtpGatherTreeNode(ANode.FirstChild));
    ANode.TotalPrice := GatherChildren(ANode);
    CalculateParent(TtpGatherTreeNode(ANode.NextSibling));
  end;

begin
  CalculateParent(TtpGatherTreeNode(Root.FirstChild));
end;

procedure TtpGatherTree.CheckNodeParted(ANode: TtpGatherTreeNode);
begin
  if not Assigned(ANode) then Exit;

  if Assigned(ANode.FirstChild) then
  begin
    CheckNodeParted(TtpGatherTreeNode(ANode.FirstChild));
    ANode.Parted := GetParentParted(ANode);
  end;

  CheckNodeParted(TtpGatherTreeNode(ANode.NextSibling));
end;

procedure TtpGatherTree.CheckNodeRelaPeg(ANode: TtpGatherTreeNode);
begin
  if not Assigned(ANode) then Exit;

  if Assigned(ANode.FirstChild) then
  begin
    CheckNodeRelaPeg(TtpGatherTreeNode(ANode.FirstChild));
    ANode.RelaPeg := GetParentRelaPeg(ANode);
  end;

  CheckNodeRelaPeg(TtpGatherTreeNode(ANode.NextSibling));
end;

procedure TtpGatherTree.CheckParted;
begin
  CheckNodeParted(TtpGatherTreeNode(Root.FirstChild));
end;

procedure TtpGatherTree.CheckRelaPeg;
begin
  CheckNodeRelaPeg(TtpGatherTreeNode(Root.FirstChild));
end;

function TtpGatherTree.FindNextSibling(AParent: TtpGatherTreeNode;
  ARec: TBillsRecord): TtpGatherTreeNode;
var
  vNode: TtpGatherTreeNode;
  sCodeID, sCodeID2, sB_CodeID, sB_CodeID2: string;
begin
  if Assigned(AParent) then
    vNode := TtpGatherTreeNode(AParent.FirstChild)
  else
    vNode := TtpGatherTreeNode(Root.FirstChild);
  Result := nil;
  if (ARec.Code.AsString = '') and (ARec.B_Code.AsString = '') then Exit;

  sCodeID := ConvertDigitCode(ARec.Code.AsString, 3, '-');
  sB_CodeID := ConvertDigitCode(ARec.B_Code.AsString, 4, '-');
  while Assigned(vNode) do
  begin
    sCodeID2 := ConvertDigitCode(vNode.Code, 3, '-');
    sB_CodeID2 := ConvertDigitCode(vNode.B_Code, 4, '-');
    if sCodeID < sCodeID2 then
    begin
      Result := vNode;
      Break;
    end
    else if sB_CodeID < sB_CodeID2 then
    begin
      Result := vNode;
      Break;
    end;
    vNode := TtpGatherTreeNode(vNode.NextSibling);
  end;
end;

function TtpGatherTree.FindNode(AParent: TtpGatherTreeNode; ARec: TBillsRecord): TtpGatherTreeNode;
var
  vNode: TtpGatherTreeNode;
begin
  if Assigned(AParent) then
    vNode := TtpGatherTreeNode(AParent.FirstChild)
  else
    vNode := TtpGatherTreeNode(Root.FirstChild);
  while Assigned(vNode) do
  begin
    if SameText(vNode.Code, ARec.Code.AsString) and
        SameText(vNode.B_Code, ARec.B_Code.AsString) and
        SameText(vNode.Name, ARec.Name.AsString) and
        SameText(vNode.Units, ARec.Units.AsString) and
        SamePrice(vNode.Price, ARec.Price.AsFloat) then
    begin
      Result := vNode;
      Break;
    end;
    vNode := TtpGatherTreeNode(vNode.NextSibling);
  end;
end;

function TtpGatherTree.GetNewNode: TCacheNode;
begin
  Result := TtpGatherTreeNode.Create(Self, GetNewNodeID);
  CacheNodes.Add(Result);
end;

function TtpGatherTree.GetParentParted(ANode: TtpGatherTreeNode): Boolean;
var
  i: Integer;
  vChild: TtpGatherTreeNode;
begin
  if Assigned(ANode.FirstChild) then
  begin
    Result := True;
    vChild := TtpGatherTreeNode(ANode.FirstChild);
    while Assigned(vChild) and Result do
    begin
      Result := Result and vChild.Parted;
      vChild := TtpGatherTreeNode(vChild.NextSibling);
    end;
  end
  else
    Result := ANode.Parted;
end;

function TtpGatherTree.GetParentRelaPeg(ANode: TtpGatherTreeNode): Boolean;
var
  i: Integer;
  vChild: TtpGatherTreeNode;
begin
  if Assigned(ANode.FirstChild) then
  begin
    Result := True;
    vChild := TtpGatherTreeNode(ANode.FirstChild);
    while Assigned(vChild) and Result do
    begin
      Result := Result and vChild.RelaPeg;
      vChild := TtpGatherTreeNode(vChild.NextSibling);
    end;
  end
  else
    Result := ANode.RelaPeg;
end;

function TtpGatherTree.SamePrice(APrice1, APrice2: Double): Boolean;
begin
  Result := (APrice1 - APrice2) < 0.001;
end;

procedure TtpGatherTree.WriteData(ADataSet: TsdDataSet);

  procedure BeforeWrite;
  begin
    ADataSet.DisableControls;
    ADataSet.BeginUpdate;
    ADataSet.DeleteAll;
  end;

  procedure AfterWrite;
  begin
    ADataSet.EndUpdate;
    ADataSet.EnableControls;
  end;

var
  i: Integer;
  vNode: TtpGatherTreeNode;
  Rec: TsdDataRecord;
begin
  BeforeWrite;
  try
    for i := 0 to CacheNodes.Count - 1 do
    begin
      vNode := TtpGatherTreeNode(CacheNodes.Items[i]);
      Rec := ADataSet.Add;
      Rec.ValueByName('ID').AsInteger := vNode.ID;
      Rec.ValueByName('ParentID').AsInteger := vNode.ParentID;
      Rec.ValueByName('NextSiblingID').AsInteger := vNode.NextSiblingID;
      Rec.ValueByName('Code').AsString := vNode.Code;
      Rec.ValueByName('B_Code').AsString := vNode.B_Code;
      Rec.ValueByName('Name').AsString := vNode.Name;
      Rec.ValueByName('Units').AsString := vNode.Units;
      Rec.ValueByName('Price').AsFloat := vNode.Price;
      Rec.ValueByName('Quantity').AsFloat := vNode.Quantity;
      Rec.ValueByName('TotalPrice').AsFloat := vNode.TotalPrice;
      Rec.ValueByName('DgnQuantity1').AsFloat := vNode.DgnQuantity1;
      Rec.ValueByName('DgnQuantity2').AsFloat := vNode.DgnQuantity2;
    end;
  finally
    AfterWrite;
  end;
end;

end.