Measure/Units/BillsTree.pas

unit BillsTree;

interface

uses
  sdIDTree, sdDB, mDataRecord, ZhAPI;

type
  TBillsIDTreeNode = class(TsdIDTreeNode)
  private     
    FStageRec: TStageRecord;

    FDealQuantity: Double;
    FDealTotalPrice: Double;
    FQcQuantity: Double;
    FQcTotalPrice: Double;
    FPcQuantity: Double;
    FPcTotalPrice: Double;
    FGatherTotalPrice: Double;
    FGatherQuantity: Double;

    function HasCountPrice: Boolean;
    function HasTotalPrice: Boolean;

    function GetRec: TBillsRecord;
    function GetChapterParentID: Integer;
    function GetChapterParent: TBillsIDTreeNode;
  public
    function CanUpLevel: Boolean; override;
    function CanDownLevel: Boolean; override;
    function CanUpMove: Boolean; override;
    function CanDownMove: Boolean; override;

    function UpLevel: Boolean; override;
    function DownLevel: Boolean; override;

    function HasMeasure: Boolean;
    function HasLedger: Boolean;

    function CountPriceEnable: Boolean;
    function TotalPriceEnable: Boolean;

    procedure RecodeChildrenCode(const AParentCode: string);
    procedure RecodeChildrenB_Code(const AParentCode: string);

    property Rec: TBillsRecord read GetRec;

    property ChapterParent: TBillsIDTreeNode read GetChapterParent;
    property ChapterParentID: Integer read GetChapterParentID;

    property DealQuantity: Double read FDealQuantity write FDealQuantity;
    property DealTotalPrice: Double read FDealTotalPrice write FDealTotalPrice;
    property QcQuantity: Double read FQcQuantity write FQcQuantity;
    property QcTotalPrice: Double read FQcTotalPrice write FQcTotalPrice;
    property PcQuantity: Double read FPcQuantity write FPcQuantity;
    property PcTotalPrice: Double read FPcTotalPrice write FPcTotalPrice;
    property GatherQuantity: Double read FGatherQuantity write FGatherQuantity;
    property GatherTotalPrice: Double read FGatherTotalPrice write FGatherTotalPrice;

    // Cache Data
    property StageRec: TStageRecord read FStageRec write FStageRec;
  end;

  TReCalculateNode = procedure(AID: Integer) of object;

  TBillsIDTree = class(TsdIDTree)
  private
    function GetNewID(AID: Integer = -1): Integer;
  protected
    function CreateItem: TsdIDTreeNode; override;
  public
    function CanDelete(ANode: TsdIDTreeNode): Boolean; override;
    function DeleteNode(ANode: TsdIDTreeNode): Boolean; override;

    function Add(AParentID, ANextSiblingID: TsdTreeNodeID): TsdIDTreeNode; override;
    function AddNode(AParentID, ANextSiblingID: TsdTreeNodeID; AID: Integer = -1): TsdIDTreeNode;

    procedure RecodeChildrenCode(ANode: TBillsIDTreeNode; AOrgCode, ANewCode: string);
    procedure RecodeChildrenB_Code(ANode: TBillsIDTreeNode; AOrgCode, ANewCode: string);

    procedure DoOnReCalcNode(AID: Integer); overload; virtual; abstract;
    procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; virtual; abstract;
  end;

  TCompileBillsIDTree = class(TBillsIDTree)
  private
    FOnReCalcNode: TReCalculateNode;
  public
    procedure DoOnReCalcNode(AID: Integer); overload; override;
    procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; override;

    property OnReCalcNode: TReCalculateNode read FOnReCalcNode write FOnReCalcNode;
  end;

  TMeasureBillsIDTreeNode = class(TBillsIDTreeNode)
  private
    FStageRec: TStageRecord;
  public
    // Cache Data
    property StageRec: TStageRecord read FStageRec write FStageRec;
  end;

  TMeasureBillsIDTree = class(TBillsIDTree)
  private
    FCompileTree: TCompileBillsIDTree;
  protected
    function CreateItem: TsdIDTreeNode; override;
  public
    procedure DoOnReCalcNode(AID: Integer); overload; override;
    procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; override;

    property CompileTree: TCompileBillsIDTree read FCompileTree write FCompileTree;
  end;

  TEstimateIDTreeNode = class(TsdIDTreeNode)
  public
    function CanExpand: Boolean; override;
  end;

  TEstimateIDTree = class(TsdIDTree)
  public
    function CreateItem: TsdIDTreeNode; override;
  end;

implementation

uses SysUtils, UtilMethods;

{ TBillsIDTree }

function TBillsIDTree.Add(AParentID,
  ANextSiblingID: TsdTreeNodeID): TsdIDTreeNode;
begin
  // 不允许插入首层节点
  if (Selected <> nil) and (Selected.Level = 0) then
    Result := inherited Add(Selected.ID, -1)
  else
    Result := inherited Add(AParentID, ANextSiblingID);
end;

function TBillsIDTree.AddNode(AParentID, ANextSiblingID: TsdTreeNodeID;
  AID: Integer): TsdIDTreeNode;
var
  iID: Integer;
  Rec: TsdDataRecord;
begin
  if not (Assigned(DataView) and DataView.Active){Active} then
  begin
    WarningMessage('无法在一个关闭的数据集上执行该操作');
    Exit;
  end;
  Result := nil;

  if CanAdd(AParentID, ANextSiblingID) then
  begin
    Rec := DataView.Append(True);
    try
      Rec.AddValue(ParentField, AParentID);
      Rec.AddValue(NextSiblingField, ANextSiblingID);
      iID := GetNewID(AID);
      if AutoCreateKeyID then
        Rec.AddValue(KeyField, iID);
      InitDBRecord(Rec);
    finally
      Rec.EndUpdate;
    end;
    Result := Add(iID, AParentID, ANextSiblingID, Rec);
  end;
end;

function TBillsIDTree.CanDelete(ANode: TsdIDTreeNode): Boolean;
begin
  Result := Inherited CanDelete(ANode)
            and ((ANode.ID >= 100) or (ANode.Level > 0))
            and (not ANode.Rec.ValueByName('LockedLevel').AsBoolean)
            and (ANode.Rec.ValueByName('AddDealQuantity').AsFloat = 0)
            and (ANode.Rec.ValueByName('AddDealTotalPrice').AsFloat = 0)
            and (ANode.Rec.ValueByName('AddQcQuantity').AsFloat = 0)
            and (ANode.Rec.ValueByName('AddQcTotalPrice').AsFloat = 0)
            and (ANode.Rec.ValueByName('AddPcQuantity').AsFloat = 0)
            and (ANode.Rec.ValueByName('AddPcTotalPrice').AsFloat = 0);
end;

function TBillsIDTree.CreateItem: TsdIDTreeNode;
begin
  Result := TBillsIDTreeNode.Create(Self);
end;

function TBillsIDTree.DeleteNode(ANode: TsdIDTreeNode): Boolean;
var
  vParent: TsdIDTreeNode;
begin
  vParent := ANode.Parent;
  Result := inherited DeleteNode(ANode);
  DoOnReCalcNode(vParent);
end;

function TBillsIDTree.GetNewID(AID: Integer): Integer;
var
  vNode: TsdIDTreeNode;
begin
  vNode := FindNode(AID);
  if Assigned(vNode) or (AID <= 0) or (AID >= 100) then
    Result := NextNewID
  else
    Result := AID;
end;

procedure TBillsIDTree.RecodeChildrenB_Code(ANode: TBillsIDTreeNode;
  AOrgCode, ANewCode: string);
var
  iCount, iTotal: Integer;
  vChild: TBillsIDTreeNode;
begin
  if (ANewCode = '') or (AOrgCode = '') or (AOrgCode = ANewCode) then Exit;

  iCount := 0;
  iTotal := ANode.PosterityCount;
  vChild := TBillsIDTreeNode(ANode.NextNode);
  while (iCount < iTotal) and Assigned(vChild) do
  begin
    if vChild.Rec.B_Code.AsString <> '' then
    begin
      if Pos(AOrgCode+'-', vChild.Rec.B_Code.AsString) = 1 then
      begin
        vChild.Rec.B_Code.AsString := StringReplace(vChild.Rec.B_Code.AsString,
            AOrgCode+'-', ANewCode+'-', []);
        vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
      end;
    end;
    vChild := TBillsIDTreeNode(vChild.NextNode);
    Inc(iCount);
  end;
end;

procedure TBillsIDTree.RecodeChildrenCode(ANode: TBillsIDTreeNode;
  AOrgCode, ANewCode: string);
var
  iCount, iTotal: Integer;
  vChild: TBillsIDTreeNode;
begin
  if (ANewCode = '') or (AOrgCode = '') or (AOrgCode = ANewCode) then Exit;

  iCount := 0;
  iTotal := ANode.PosterityCount;
  vChild := TBillsIDTreeNode(ANode.NextNode);
  while (iCount < iTotal) and Assigned(vChild) do
  begin
    if vChild.Rec.Code.AsString <> '' then
    begin
      if Pos(AOrgCode+'-', vChild.Rec.Code.AsString) = 1 then
      begin
        vChild.Rec.Code.AsString := StringReplace(vChild.Rec.Code.AsString,
            AOrgCode+'-', ANewCode+'-', []);
        vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
      end;
    end;
    vChild := TBillsIDTreeNode(vChild.NextNode);
    Inc(iCount);
  end;
end;

{ TBillsIDTreeNode }

function TBillsIDTreeNode.CanDownLevel: Boolean;
begin
  Result := Inherited CanDownLevel
            and (Level > 0)
            and (not Rec.ValueByName('LockedLevel').AsBoolean)
            and not HasMeasure;

  if Assigned(PrevSibling) then
  begin
    Result := Result
              and (PrevSibling.HasChildren or not TBillsIDTreeNode(PrevSibling).HasMeasure);
  end;
end;

function TBillsIDTreeNode.CanDownMove: Boolean;
begin
  Result := Inherited CanDownMove
            and (not Rec.ValueByName('LockedLevel').AsBoolean);
end;

function TBillsIDTreeNode.CanUpLevel: Boolean;
var
  vNextSibling: TsdIDTreeNode;
begin
  Result := Inherited CanUpLevel
            and (Level > 1)
            and (not Rec.ValueByName('LockedLevel').AsBoolean)
            and not HasMeasure;

  vNextSibling := NextSibling;
  while Assigned(vNextSibling) and Result do
  begin
    Result := Result
              and not TBillsIDTreeNode(NextSibling).HasMeasure;
    vNextSibling := vNextSibling.NextSibling;
  end;
end;

function TBillsIDTreeNode.CanUpMove: Boolean;
begin
  Result := Inherited CanUpMove
            and (not Rec.ValueByName('LockedLevel').AsBoolean);
end;

function TBillsIDTreeNode.CountPriceEnable: Boolean;
begin
  Result := HasCountPrice or (not HasTotalPrice);
end;

function TBillsIDTreeNode.DownLevel: Boolean;
var
  iOrgParentID: Integer;
begin
  iOrgParentID := ParentID;
  Result := inherited DownLevel;

  if not Result then Exit;
  // 如升级后变为父项，则清空数量、单价
  if Assigned(Parent) then
  begin
    Parent.Rec.ValueByName('OrgQuantity').AsFloat := 0;
    Parent.Rec.ValueByName('MisQuantity').AsFloat := 0;
    Parent.Rec.ValueByName('OthQuantity').AsFloat := 0;
    Parent.Rec.ValueByName('Quantity').AsFloat := 0;
    Parent.Rec.ValueByName('Price').AsFloat := 0;
  end;

  TBillsIDTree(Owner).DoOnReCalcNode(ParentID);
  TBillsIDTree(Owner).DoOnReCalcNode(iOrgParentID);
end;

function TBillsIDTreeNode.GetChapterParent: TBillsIDTreeNode;
begin
  Result := nil;
  if Self.Level <= 1 then Exit;

  Result := TBillsIDTreeNode(Self.Parent);
  while Result.Level > 1 do
    Result := TBillsIDTreeNode(Result.Parent);
end;

function TBillsIDTreeNode.GetChapterParentID: Integer;
var
  vNode: TBillsIDTreeNode;
begin
  vNode := GetChapterParent;
  if Assigned(vNode) then
    Result := vNode.ID
  else
    Result := -1;
end;

function TBillsIDTreeNode.GetRec: TBillsRecord;
begin
  Result := TBillsRecord(TsdIDTreeNode(Self).Rec);
end;

function TBillsIDTreeNode.HasCountPrice: Boolean;
begin
  Result := False;
  if not Assigned(Rec) then Exit;
  Result := (Rec.Price.AsFloat <> 0)
         or (Rec.OrgQuantity.AsFloat <> 0)
         or (Rec.MisQuantity.AsFloat <> 0)
         or (Rec.OthQuantity.AsFloat <> 0)
         or (Rec.AddDealQuantity.AsFloat <> 0)
         or (Rec.AddQcQuantity.AsFloat <> 0)
         or (Rec.AddPcQuantity.AsFloat <> 0);
end;

function TBillsIDTreeNode.HasLedger: Boolean;
begin
  Result := False;
  if not Assigned(Rec) then Exit;
  Result := (Rec.Price.AsFloat <> 0)
            or (Rec.Quantity.AsFloat <> 0);
end;

function TBillsIDTreeNode.HasMeasure: Boolean;
begin
  Result := False;
  if not Assigned(Rec) then Exit;
  Result := (Rec.AddDealQuantity.AsFloat <> 0)
            or (Rec.AddDealTotalPrice.AsFloat <> 0)
            or (Rec.AddQcQuantity.AsFloat <> 0)
            or (Rec.AddQcTotalPrice.AsFloat <> 0)
            or (Rec.AddPcQuantity.AsFloat <> 0)
            or (Rec.AddPcTotalPrice.AsFloat <> 0);
end;

function TBillsIDTreeNode.HasTotalPrice: Boolean;
begin
  Result := False;
  if not Assigned(Rec) then Exit;
  Result := (Rec.OrgTotalPrice.AsFloat <> 0)
         or (Rec.MisTotalPrice.AsFloat <> 0)
         or (Rec.OthTotalPrice.AsFloat <> 0)
         or (Rec.AddDealTotalPrice.AsFloat <> 0)
         or (Rec.AddQcTotalPrice.AsFloat <> 0)
         or (Rec.AddPcTotalPrice.AsFloat <> 0);
end;

procedure TBillsIDTreeNode.RecodeChildrenB_Code(const AParentCode: string);
var
  iChild: Integer;
  vChild: TBillsIDTreeNode;
begin
  if (AParentCode = '') then Exit;

  for iChild := 0 to Self.ChildCount - 1 do
  begin
    vChild := TBillsIDTreeNode(Self.ChildNodes[iChild]);
    if vChild.Rec.B_Code.AsString <> '' then
    begin
      vChild.Rec.SetStrValue(vChild.Rec.B_Code, AParentCode + '-' + GetLastSetmentOfCode(AParentCode));
      vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
    end;
  end;
end;

procedure TBillsIDTreeNode.RecodeChildrenCode(const AParentCode: string);
var
  iChild: Integer;
  vChild: TBillsIDTreeNode;
begin
  if (AParentCode = '') then Exit;

  for iChild := 0 to Self.ChildCount - 1 do
  begin
    vChild := TBillsIDTreeNode(Self.ChildNodes[iChild]);
    if vChild.Rec.Code.AsString <> '' then
    begin
      vChild.Rec.SetStrValue(vChild.Rec.Code, AParentCode + '-' + GetLastSetmentOfCode(AParentCode));
      vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
    end;
  end;
end;

function TBillsIDTreeNode.TotalPriceEnable: Boolean;
begin
  Result := not HasCountPrice;
end;

function TBillsIDTreeNode.UpLevel: Boolean;
var
  iOrgParentID: Integer;
begin
  iOrgParentID := ParentID;
  Result := inherited UpLevel;

  if not Result then Exit;
  // 如升级后变为父项，则清空数量、单价
  if HasChildren then
  begin
    Rec.ValueByName('OrgQuantity').AsFloat := 0;
    Rec.ValueByName('MisQuantity').AsFloat := 0;
    Rec.ValueByName('OthQuantity').AsFloat := 0;
    Rec.ValueByName('Quantity').AsFloat := 0;
    Rec.ValueByName('Price').AsFloat := 0;
  end;

  TBillsIDTree(Owner).DoOnReCalcNode(iOrgParentID);
  TBillsIDTree(Owner).DoOnReCalcNode(ParentID);
end;

{ TEstimateIDTreeNode }

function TEstimateIDTreeNode.CanExpand: Boolean;
var
  iChild: Integer;
  vChild: TsdIDTreeNode;
begin
  Result := True;
  if HasChildren then
    for iChild := 0 to ChildCount - 1 do
    begin
      vChild := ChildNodes[iChild];
      if vChild.Rec.ValueByName('B_Code').AsString <> '' then
      begin
        Result := False;
        Break;
      end;
    end;
end;

{ TEstimateIDTree }

function TEstimateIDTree.CreateItem: TsdIDTreeNode;
begin
  Result := TEstimateIDTreeNode.Create(Self);
end;

{ TCompileBillsIDTree }

procedure TCompileBillsIDTree.DoOnReCalcNode(AID: Integer);
begin
  if (AID <> -1) and Assigned(FOnReCalcNode) then
    FOnReCalcNode(AID);
end;

procedure TCompileBillsIDTree.DoOnReCalcNode(ANode: TsdIDTreeNode);
begin
  if Assigned(ANode) then
    DoOnReCalcNode(ANode.ID);
end;

{ TMeasureBillsIDTree }

procedure TMeasureBillsIDTree.DoOnReCalcNode(AID: Integer);
begin
  if Assigned(FCompileTree) then
    FCompileTree.DoOnReCalcNode(AID);
end;

function TMeasureBillsIDTree.CreateItem: TsdIDTreeNode;
begin
  Result := TMeasureBillsIDTreeNode.Create(Self);  
end;

procedure TMeasureBillsIDTree.DoOnReCalcNode(ANode: TsdIDTreeNode);
begin
  if Assigned(FCompileTree) then
    FCompileTree.DoOnReCalcNode(ANode);
end;

end.