Measure/DataModules/ReportMemoryDm/rmDealInfosDm.pas

unit rmDealInfosDm;

interface

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

type
  TInfoNode = class
  private
    // 合同类别
    FDealType: string;
    // 合同编号
    FDealCode: string;
    // 结算书编号
    FBalanceCode: string;
    // 合同名称
    FDealName: string;
    // 签订单位
    FDealCompany: string;
    // 合同金额
    FDealTotalPrice: Double;
    // 结算金额
    FFinalTotalPrice: Double;
    // 累计应扣款
    FCutTotalPrice: Double;
    // 累计已支付
    FPaidTotalPrice: Double;
    // 签约合同价 （单合同：取项目属性签约合同价，多合同：取0号台账合同）
    FContractPrice: Double;
  public
    constructor Create;
  end;

  TrmDealInfosData = class(TDataModule)
    cdsDealInfos: TClientDataSet;
    cdsDealInfosDealType: TWideStringField;
    cdsDealInfosDealCode: TWideStringField;
    cdsDealInfosDealCompany: TWideStringField;
    cdsDealInfosDealTotalPrice: TFloatField;
    cdsDealInfosFinalTotalPrice: TFloatField;
    cdsDealInfosCutTotalPrice: TFloatField;
    cdsDealInfosPayTotalPrice: TFloatField;
    cdsDealInfosPaidTotalPrice: TFloatField;
    cdsDealInfosPayingTotalPrice: TFloatField;
    cdsDealInfosMemoStr: TWideStringField;
    cdsDealInfosBalanceCode: TWideStringField;
    cdsDealInfosDealName: TWideStringField;
    cdsDealInfosPayPercent: TFloatField;
    cdsDealInfosContractPrice: TFloatField;
  private
    FDealInfos: TList;
    FTotalDealInfo: TInfoNode;
    FProjectData: TProjectData;

    procedure BeforeGather;
    procedure AfterGather;

    procedure OpenProjectData(AProjectID: Integer);
    procedure FreeProjectData;

    procedure AddBillsDealInfo(ANode: TsdIDTreeNode);
    procedure AddBillsDeal(ANode: TsdIDTreeNode);

    // 标段为合同
    procedure AddDealProjectInfo(AProjectID: Integer);
    // 标段内含多个合同
    procedure AddProjectDealInfos(AProjectID: Integer);
    procedure AddDealInfo(AProject: TSelectProject);

    procedure GatherTotalDealInfo;

    procedure WriteDealInfoData;
  public
    function AssignData(AProjects: TList): TDataSet;
  end;

implementation

uses ProjectProperty, Globals, UtilMethods;

{$R *.dfm}

{ TrmDealInfosData }

procedure TrmDealInfosData.AddBillsDeal(ANode: TsdIDTreeNode);
begin
  if not Assigned(ANode) then Exit;
  if ANode.Rec.ValueByName('DealCode').AsString <> '' then
    AddBillsDealInfo(ANode);
  AddBillsDeal(ANode.FirstChild);
  AddBillsDeal(ANode.NextSibling);
end;

procedure TrmDealInfosData.AddBillsDealInfo(ANode: TsdIDTreeNode);
var
  DealInfo: TInfoNode;
begin
  DealInfo := TInfoNode.Create;
  FDealInfos.Add(DealInfo);

  DealInfo.FDealType := ANode.Rec.ValueByName('DealType').AsString;
  DealInfo.FDealCode := ANode.Rec.ValueByName('DealCode').AsString;
  DealInfo.FDealName := ANode.Rec.ValueByName('Name').AsString;
  DealInfo.FDealCompany := ANode.Rec.ValueByName('DealCompany').AsString;
  DealInfo.FDealTotalPrice := ANode.Rec.ValueByName('TotalPrice').AsFloat;
  DealInfo.FFinalTotalPrice := ANode.Rec.ValueByName('AddGatherTotalPrice').AsFloat;
  DealInfo.FCutTotalPrice := ANode.Rec.ValueByName('AddCutTotalPrice').AsFloat;
  DealInfo.FPaidTotalPrice := ANode.Rec.ValueByName('AddPayTotalPrice').AsFloat;
  DealInfo.FContractPrice := ANode.Rec.ValueByName('TotalPrice').AsFloat;
end;

procedure TrmDealInfosData.AddDealInfo(AProject: TSelectProject);
begin
  if AProject.IsDeal then
    AddProjectDealInfos(AProject.ProjectID)
  else
    AddDealProjectInfo(AProject.ProjectID);
end;

procedure TrmDealInfosData.AddDealProjectInfo(AProjectID: Integer);
var
  DealInfo: TInfoNode;
begin
  OpenProjectData(AProjectID);
  try
    DealInfo := TInfoNode.Create;
    FDealInfos.Add(DealInfo);

    DealInfo.FDealType := FProjectData.ProjProperties.DealType;
    DealInfo.FDealCode := FProjectData.ProjProperties.DealIndex;
    DealInfo.FDealName := FProjectData.ProjProperties.DealName;
    DealInfo.FDealCompany := FProjectData.ProjProperties.CName;
    // Bug #674 要求修改为取项目属性界面签约合同价
    DealInfo.FDealTotalPrice := FProjectData.BillsData.Settlement[0];
    DealInfo.FFinalTotalPrice := FProjectData.DealPaymentData.AddTotalPrice;
    DealInfo.FCutTotalPrice := FProjectData.DealPaymentData.CutTotalPrice;
    DealInfo.FPaidTotalPrice := FProjectData.DealPaymentData.PaidTotalPrice;
    DealInfo.FContractPrice := FProjectData.ProjProperties.ContractPrice;
  finally
    FreeProjectData;
  end;
end;

procedure TrmDealInfosData.AddProjectDealInfos(AProjectID: Integer);
begin
  OpenProjectData(AProjectID);
  try
    AddBillsDeal(FProjectData.BillsCompileData.BillsCompileTree.FirstNode);
  finally
    FreeProjectData;
  end;
end;

procedure TrmDealInfosData.AfterGather;
begin
  FTotalDealInfo.Free;
  ClearObjects(FDealInfos);
  FDealInfos.Free;

  cdsDealInfos.EnableControls;
end;

function TrmDealInfosData.AssignData(AProjects: TList): TDataSet;
var
  iProject: Integer;
begin
  BeforeGather;
  try
    for iProject := 0 to AProjects.Count - 1 do
      AddDealInfo(TSelectProject(AProjects.Items[iProject]));
    GatherTotalDealInfo;
    WriteDealInfoData;
  finally
    AfterGather;
    Result := cdsDealInfos;
  end;
end;

procedure TrmDealInfosData.BeforeGather;
begin
  cdsDealInfos.DisableControls;
  cdsDealInfos.Active := True;
  cdsDealInfos.EmptyDataSet;

  FDealInfos := TList.Create;
  FTotalDealInfo := TInfoNode.Create;
  FTotalDealInfo.FDealType := '合计';
end;

procedure TrmDealInfosData.FreeProjectData;
begin
  if not Assigned(OpenProjectManager.FindProjectData(FProjectData.ProjectID)) then
    FProjectData.Free;
end;

procedure TrmDealInfosData.GatherTotalDealInfo;
var
  i: Integer;
  DealInfo: TInfoNode;
begin
  for i := 0 to FDealInfos.Count - 1 do
  begin
    DealInfo := TInfoNode(FDealInfos.Items[i]);
    FTotalDealInfo.FDealTotalPrice := FTotalDealInfo.FDealTotalPrice + DealInfo.FDealTotalPrice;
    FTotalDealInfo.FFinalTotalPrice := FTotalDealInfo.FFinalTotalPrice + DealInfo.FFinalTotalPrice;
    FTotalDealInfo.FCutTotalPrice := FTotalDealInfo.FCutTotalPrice + DealInfo.FCutTotalPrice;
    FTotalDealInfo.FPaidTotalPrice := FTotalDealInfo.FPaidTotalPrice + DealInfo.FPaidTotalPrice;
    FTotalDealInfo.FContractPrice := FTotalDealInfo.FContractPrice + DealInfo.FContractPrice;
  end;
end;

procedure TrmDealInfosData.OpenProjectData(AProjectID: Integer);
var
  Rec: TsdDataRecord;
begin
  FProjectData := OpenProjectManager.FindProjectData(AProjectID);
  Rec := ProjectManager.sddProjectsInfo.FindKey('idxID', AProjectID);
  if not Assigned(FProjectData) then
  begin
    FProjectData := TProjectData.Create;
    FProjectData.OpenForReport(GetMyProjectsFilePath + Rec.ValueByName('FileName').AsString);
  end;
end;

procedure TrmDealInfosData.WriteDealInfoData;

  procedure WriteInfoNodeData(AInfo: TInfoNode);
  begin
    cdsDealInfos.Append;
    cdsDealInfosDealType.AsString := AInfo.FDealType;
    cdsDealInfosDealCode.AsString := AInfo.FDealCode;
    cdsDealInfosBalanceCode.AsString := AInfo.FBalanceCode;
    cdsDealInfosDealName.AsString := AInfo.FDealName;
    cdsDealInfosDealCompany.AsString := AInfo.FDealCompany;
    cdsDealInfosDealTotalPrice.AsFloat := AInfo.FDealTotalPrice;
    cdsDealInfosFinalTotalPrice.AsFloat := AInfo.FFinalTotalPrice;
    cdsDealInfosCutTotalPrice.AsFloat := AInfo.FCutTotalPrice;
    cdsDealInfosPayTotalPrice.AsFloat := AInfo.FFinalTotalPrice - AInfo.FCutTotalPrice;
    cdsDealInfosPaidTotalPrice.AsFloat := AInfo.FPaidTotalPrice;
    cdsDealInfosPayingTotalPrice.AsFloat := AInfo.FFinalTotalPrice - AInfo.FCutTotalPrice - AInfo.FPaidTotalPrice;
    if cdsDealInfosPayTotalPrice.AsFloat <> 0 then
      cdsDealInfosPayPercent.AsFloat := AdvRoundTo(
          cdsDealInfosPaidTotalPrice.AsFloat/cdsDealInfosPayTotalPrice.AsFloat*100);
    cdsDealInfosContractPrice.AsFloat := AInfo.FContractPrice;
    cdsDealInfos.Post;
  end;

var
  i: Integer;
begin
  for i := 0 to FDealInfos.Count - 1 do
    WriteInfoNodeData(TInfoNode(FDealInfos.Items[i]));
  WriteInfoNodeData(FTotalDealInfo);
end;

{ TInfoNode }

constructor TInfoNode.Create;
begin
  FDealTotalPrice := 0;
  FFinalTotalPrice := 0;
  FCutTotalPrice := 0;
  FPaidTotalPrice := 0;
  FContractPrice := 0;
end;

end.