Measure/DataModules/ReportMemoryDm/rmXmjBGLDetailDm.pas

unit rmXmjBGLDetailDm;

interface

uses
  SysUtils, Classes, DB, DBClient, ProjectData, sdIDTree, sdDB;

type
  TBGLNode = class
  private
    FBGLCode: string;
    FBGLName: string;
    FBGLReason: string;
    FDirection: string;
    FBGLType: string;
    FDrawingCode: string;
    FApprovalCode: string;
    FBGLRelaFile: string;
  end;

  TXmjNode = class
  private
    FChildList: TList;
    FBGLList: TList;

    FCode: string;
    FName: string;

    FDgnQuantity1: Double;
    FDgnQuantity2: Double;

    FEndDealTotalPrice: Double;
    FEndGatherTotalPrice: Double;

    function GetChildCount: Integer;
    function GetChildNode(AIndex: Integer): TXmjNode;
    function GetBGLCount: Integer;
    function GetBGLNode(AIndex: Integer): TBGLNode;
  public
    constructor Create;
    destructor Destroy; override;

    function FindBGLNode(const ABGLCode: string): TBGLNode;

    property ChildCount: Integer read GetChildCount;
    property ChildNode[AIndex: Integer]: TXmjNode read GetChildNode;
    property BGLCount: Integer read GetBGLCount;
    property BGLNode[AIndex: Integer]: TBGLNode read GetBGLNode;
  end;

  TrmXmjBGLDetailData = class(TDataModule)
    cdsXmjBGLDetail: TClientDataSet;
    cdsXmjBGLDetailCode: TStringField;
    cdsXmjBGLDetailName: TWideStringField;
    cdsXmjBGLDetailDgnQuantity1: TFloatField;
    cdsXmjBGLDetailDgnQuantity2: TFloatField;
    cdsXmjBGLDetailDgnQuantity: TStringField;
    cdsXmjBGLDetailXmj_BGLName: TWideStringField;
    cdsXmjBGLDetailBGLCode: TWideStringField;
    cdsXmjBGLDetailBGLName: TWideStringField;
    cdsXmjBGLDetailBGLType: TWideStringField;
    cdsXmjBGLDetailReason: TWideStringField;
    cdsXmjBGLDetailDirection: TWideStringField;
    cdsXmjBGLDetailEndDealTotalPrice: TFloatField;
    cdsXmjBGLDetailEndGatherTotalPrice: TFloatField;
    cdsXmjBGLDetailBGTotalPrice: TFloatField;
    cdsXmjBGLDetailDrawingCode: TWideStringField;
    cdsXmjBGLDetailApprovalCode: TWideStringField;
    cdsXmjBGLDetailBGLRelaFile: TWideStringField;
    cdsXmjBGLDetailMemoStr: TWideStringField;
  private
    FProjectData: TProjectData;
    FClassXmjList: TList;

    function GetDgnQuantity(ANum1, ANum2: Double): string;

    procedure AddBGL(ABGLCode: string; AClassNode: TXmjNode);
    procedure AddBGLsData(ABGLCode: string; AClassNode: TXmjNode);
    procedure FilterNodeBGLData(ANode: TsdIDTreeNode; AClassNode: TXmjNode);
    procedure FilterBGLData(ANode: TsdIDTreeNode; AClassNode: TXmjNode);

    procedure AddDetailXmjNode(ANode: TsdIDTreeNode; AClassNode: TXmjNode);
    function CheckLeafXmj(ANode: TsdIDTreeNode): Boolean;
    function CheckHasBGL(ANode: TsdIDTreeNode): Boolean;
    procedure FilterDetailNode(ANode: TsdIDTreeNode; AClassNode: TXmjNode);

    procedure AddClassXmjNode(ANode: TsdIDTreeNode);
    function CheckChildNodeHasBGL(ANode: TsdIDTreeNode): Boolean;
    procedure FilterNode(ANode: TsdIDTreeNode);

    procedure WriteBGLNodeData(ABGLNode: TBGLNode);
    procedure WriteXmjNodeData(AXmjNode: TXmjNode; AIndex: Integer = -1);
    procedure WriteData;
  public
    function AssignData(AProjectData: TProjectData): TDataSet;
  end;

implementation

uses
  ZhAPI, DateUtils, BGLDm;

{$R *.dfm}

{ TrmXmjBGLDetailData }

procedure TrmXmjBGLDetailData.AddBGL(ABGLCode: string;
  AClassNode: TXmjNode);
var
  BGLNode: TBGLNode;
begin
  BGLNode := AClassNode.FindBGLNode(ABGLCode);
  if not Assigned(BGLNode) then
  begin
    BGLNode := TBGLNode.Create;
    BGLNode.FBGLCode := ABGLCode;
    with FProjectData.BGLData do
    begin
      if cdsBGL.Locate('Code', ABGLCode, []) then
      begin
        BGLNode.FBGLName := cdsBGLName.AsString;
        BGLNode.FBGLReason := cdsBGLPos_Reason.AsString;
        BGLNode.FDirection := cdsBGLDirection.AsString;
        BGLNode.FBGLType := '';
        BGLNode.FDrawingCode := cdsBGLDrawingCode.AsString;
        BGLNode.FApprovalCode := cdsBGLApprovalCode.AsString;
        BGLNode.FBGLRelaFile := '';
      end;
    end;
    AClassNode.FBGLList.Add(BGLNode);
  end;
end;

procedure TrmXmjBGLDetailData.AddBGLsData(ABGLCode: string;
  AClassNode: TXmjNode);
var
  sgs: TStrings;
  i: Integer;
begin
  if ABGLCode = '' then Exit;
  sgs := TStringList.Create;
  try
    sgs.Delimiter := ';';
    sgs.DelimitedText := ABGLCode;
    for i := 0 to sgs.Count - 1 do
      AddBGL(sgs.Strings[i], AClassNode);
  finally
    sgs.Free;
  end;
end;

procedure TrmXmjBGLDetailData.AddClassXmjNode(ANode: TsdIDTreeNode);
var
  XmjNode: TXmjNode;
begin
  if not Assigned(ANode) then Exit;
  XmjNode := TXmjNode.Create;
  FClassXmjList.Add(XmjNode);
  XmjNode.FCode := ANode.Rec.ValueByName('Code').AsString;
  XmjNode.FName := ANode.Rec.ValueByName('Name').AsString;
  XmjNode.FDgnQuantity1 := ANode.Rec.ValueByName('DgnQuantity1').AsFloat;
  FilterDetailNode(ANode, XmjNode);
end;

procedure TrmXmjBGLDetailData.AddDetailXmjNode(ANode: TsdIDTreeNode;
  AClassNode: TXmjNode);
var
  DetailNode: TXmjNode;
  StageRec: TsdDataRecord;
begin
  DetailNode := TXmjNode.Create;
  AClassNode.FChildList.Add(DetailNode);
  DetailNode.FName := ANode.Rec.ValueByName('Name').AsString;
  DetailNode.FDgnQuantity1 := ANode.Rec.ValueByName('DgnQuantity1').AsFloat;
  DetailNode.FDgnQuantity2 := ANode.Rec.ValueByName('DgnQuantity2').AsFloat;
  if FProjectData.PhaseData.Active then
  begin
    StageRec := FProjectData.PhaseData.StageData.StageRecord(ANode.ID);
    if Assigned(StageRec) then
    begin
      DetailNode.FEndDealTotalPrice := StageRec.ValueByName('EndDealTotalPrice').AsFloat;
      DetailNode.FEndGatherTotalPrice := StageRec.ValueByName('EndGatherTotalPrice').AsFloat;
    end;
  end;
  FilterBGLData(ANode, DetailNode);
end;

function TrmXmjBGLDetailData.AssignData(
  AProjectData: TProjectData): TDataSet;
begin
  FProjectData := AProjectData;
  FClassXmjList := TList.Create;
  cdsXmjBGLDetail.Active := True;
  cdsXmjBGLDetail.EmptyDataSet;
  cdsXmjBGLDetail.DisableControls;
  try
    FilterNode(AProjectData.BillsCompileData.BillsCompileTree.FirstNode);
    WriteData;
  finally
    cdsXmjBGLDetail.EnableControls;
    Result := cdsXmjBGLDetail;
    ClearObjects(FClassXmjList);
    FClassXmjList.Free;
  end;
end;

function TrmXmjBGLDetailData.CheckChildNodeHasBGL(
  ANode: TsdIDTreeNode): Boolean;
var
  iNext, iTotal: Integer;
  vChild: TsdIDTreeNode;
begin
  Result := False;
  if not Assigned(ANode) then Exit;
  iNext := 1;
  iTotal := ANode.PosterityCount;
  vChild := ANode.NextNode;
  while (iNext <= iTotal) and not Result do
  begin
    if not vChild.HasChildren then
      Result := CheckHasBGL(vChild);
    vChild := vChild.NextNode;
    Inc(iNext);
  end;
end;

function TrmXmjBGLDetailData.CheckHasBGL(ANode: TsdIDTreeNode): Boolean;
var
  StageRec: TsdDataRecord;
begin
  Result := False;
  StageRec := FProjectData.PhaseData.StageData.StageRecord(ANode.ID);
  if Assigned(StageRec) then
    Result := (StageRec.ValueByName('EndQcTotalPrice').AsFloat <> 0)
           or (StageRec.ValueByName('EndPcTotalPrice').AsFloat <> 0);
end;

function TrmXmjBGLDetailData.CheckLeafXmj(ANode: TsdIDTreeNode): Boolean;
var
  i: Integer;
begin
  Result := True;
  for i := 0 to ANode.ChildCount - 1 do
  begin
    if ANode.ChildNodes[i].Rec.ValueByName('B_Code').AsString = '' then
    begin
      Result := False;
      Break;
    end;
  end;
end;

procedure TrmXmjBGLDetailData.FilterBGLData(ANode: TsdIDTreeNode;
  AClassNode: TXmjNode);
var
  i: Integer;
begin
  if not Assigned(ANode) then Exit;
  if ANode.HasChildren then
    for i := 0 to ANode.ChildCount - 1 do
      FilterBGLData(ANode.ChildNodes[i], AClassNode)
  else
    FilterNodeBGLData(ANode, AClassNode);
end;

procedure TrmXmjBGLDetailData.FilterDetailNode(ANode: TsdIDTreeNode;
  AClassNode: TXmjNode);
var
  i: Integer;
begin
  if not Assigned(ANode) and (ANode.Level < 2) then Exit;
  if ANode.Rec.ValueByName('B_Code').AsString <> '' then Exit;

  if CheckLeafXmj(ANode) and CheckHasBGL(ANode) then
    AddDetailXmjNode(ANode, AClassNode);

  if ANode.HasChildren then
  begin
    for i := 0 to ANode.ChildCount - 1 do
      FilterDetailNode(ANode.ChildNodes[i], AClassNode);
  end;
end;

procedure TrmXmjBGLDetailData.FilterNode(ANode: TsdIDTreeNode);
begin
  if not Assigned(ANode) then Exit;
  if ANode.Level> 1 then Exit;
  if ANode.Level = 0 then
    FilterNode(ANode.FirstChild)
  else if CheckHasBGL(ANode) then
    AddClassXmjNode(ANode);
  FilterNode(ANode.NextSibling);
end;

procedure TrmXmjBGLDetailData.FilterNodeBGLData(ANode: TsdIDTreeNode;
  AClassNode: TXmjNode);
var
  StageRec: TsdDataRecord;
begin
  StageRec := FProjectData.PhaseData.StageData.StageRecord(ANode.ID);
  if not Assigned(StageRec) then Exit;
  AddBGLsData(StageRec.ValueByName('EndQcBGLCode').AsString, AClassNode);
  AddBGLsData(StageRec.ValueByName('EndPcBGLCode').AsString, AClassNode);
end;

function TrmXmjBGLDetailData.GetDgnQuantity(ANum1, ANum2: Double): string;
begin
  Result := '';
  if ANum1 <> 0 then
  begin
    Result := FloatToStr(ANum1);
    if ANum2 <> 0 then
      Result := Result + '/' + FloatToStr(ANum2);
  end;
end;

procedure TrmXmjBGLDetailData.WriteBGLNodeData(ABGLNode: TBGLNode);
begin
  cdsXmjBGLDetail.Append;
  cdsXmjBGLDetailXmj_BGLName.AsString := ABGLNode.FBGLName;

  cdsXmjBGLDetailBGLCode.AsString := ABGLNode.FBGLCode;
  cdsXmjBGLDetailBGLName.AsString := ABGLNode.FBGLName;

  cdsXmjBGLDetailReason.AsString := ABGLNode.FBGLReason;
  cdsXmjBGLDetailDirection.AsString := ABGLNode.FDirection;

  cdsXmjBGLDetailDrawingCode.AsString := ABGLNode.FDrawingCode;
  cdsXmjBGLDetailApprovalCode.AsString := ABGLNode.FApprovalCode;
  cdsXmjBGLDetailBGLRelaFile.AsString := ABGLNode.FBGLRelaFile;
  cdsXmjBGLDetail.Post;
end;

procedure TrmXmjBGLDetailData.WriteData;
var
  i: Integer;
begin
  for i := 0 to FClassXmjList.Count - 1 do
    WriteXmjNodeData(TXmjNode(FClassXmjList.Items[i]));
end;

procedure TrmXmjBGLDetailData.WriteXmjNodeData(AXmjNode: TXmjNode;
  AIndex: Integer);
var
  i: Integer;
begin
  cdsXmjBGLDetail.Append;
  if AIndex = -1 then
    cdsXmjBGLDetailCode.AsString := AXmjNode.FCode
  else
    cdsXmjBGLDetailCode.AsString := IntToStr(AIndex + 1);
  cdsXmjBGLDetailName.AsString := AXmjNode.FName;

  cdsXmjBGLDetailDgnQuantity1.AsFloat := AXmjNode.FDgnQuantity1;
  cdsXmjBGLDetailDgnQuantity2.AsFloat := AXmjNode.FDgnQuantity2;
  cdsXmjBGLDetailDgnQuantity.AsString := GetDgnQuantity(AXmjNode.FDgnQuantity1, AXmjNode.FDgnQuantity2);

  cdsXmjBGLDetailEndDealTotalPrice.AsFloat := AXmjNode.FEndDealTotalPrice;
  cdsXmjBGLDetailEndGatherTotalPrice.AsFloat := AXmjNode.FEndGatherTotalPrice;
  cdsXmjBGLDetailBGTotalPrice.AsFloat := AXmjNode.FEndGatherTotalPrice - AXmjNode.FEndDealTotalPrice;

  cdsXmjBGLDetailXmj_BGLName.AsString := AXmjNode.FName;
  cdsXmjBGLDetail.Post;
  for i := 0 to AXmjNode.BGLCount - 1 do
    WriteBGLNodeData(AXmjNode.BGLNode[i]);
  for i := 0 to AXmjNode.ChildCount - 1 do
    WriteXmjNodeData(AXmjNode.ChildNode[i], i);
end;

{ TXmjNode }

constructor TXmjNode.Create;
begin
  FChildList := TList.Create;
  FBGLList := TList.Create;
end;

destructor TXmjNode.Destroy;
begin
  ClearObjects(FBGLList);
  FBGLList.Free;
  ClearObjects(FChildList);
  FChildList.Free;
  inherited;
end;

function TXmjNode.FindBGLNode(const ABGLCode: string): TBGLNode;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to BGLCount - 1 do
  begin
    if BGLNode[i].FBGLCode = ABGLCode then
    begin
      Result := BGLNode[i];
      Break;
    end;
  end;
end;

function TXmjNode.GetBGLCount: Integer;
begin
  Result := FBGLList.Count;
end;

function TXmjNode.GetBGLNode(AIndex: Integer): TBGLNode;
begin
  Result := TBGLNode(FBGLList.Items[AIndex]);
end;

function TXmjNode.GetChildCount: Integer;
begin
  Result := FChildList.Count;
end;

function TXmjNode.GetChildNode(AIndex: Integer): TXmjNode;
begin
  Result := TXmjNode(FChildList.Items[AIndex]);
end;

end.