Measure/DataModules/BillsDm.pas

unit BillsDm;

interface

uses
  StandardBillsFme,
  ZhAPI, StandardLib, StageDm, BillsTree, mDataRecord,
  SysUtils, Classes, sdDB, sdProvider, ADODB, sdIDTree, Math;

const
  DealIndex = 0;
  AddDealIndex = 1;
  AddQcIndex = 2;
  AddPcIndex = 3;
  AddGatherIndex = 4;

type
  TRecChangeEvent = procedure (ARec: TsdDataRecord) of object;

  TBillsData = class(TDataModule)
    sdpBills: TsdADOProvider;
    sddBills: TsdDataSet;
    procedure sddBillsAfterAddRecord(ARecord: TsdDataRecord);
    procedure sddBillsBeforeDeleteRecord(ARecord: TsdDataRecord;
      var Allow: Boolean);
    procedure sddBillsBeforeValueChange(AValue: TsdValue;
      const NewValue: Variant; var Allow: Boolean);
    procedure sddBillsGetRecordClass(var ARecordClass: TsdRecordClass);
  private
    FProjectData: TObject;
    FCurPhaseIndex: Integer;
    FBeforeChangeTotalPrice: Double;
    FBeforeChangeParentID: Integer;

    //procedure RecursiveCalculate(ABillsID: Integer);

    function GetStageData: TStageData;

    function GetBuildLoadInterest(AIndex: Integer): Double;
    function GetFirstPart(AIndex: Integer): Double;
    function GetOtherFee(AIndex: Integer): Double;
    function GetOtherProjectFee(AIndex: Integer): Double;
    function GetRecyclingFee(AIndex: Integer): Double;
    function GetReservedFee(AIndex: Integer): Double;
    function GetSecondPart(AIndex: Integer): Double;
    function GetStageSettlement(AIndex: Integer): Double;
    function GetThirdPart(AIndex: Integer): Double;
  public
    constructor Create(AProjectData: TObject);
    destructor Destroy; override;

    procedure Open(AConnection: TADOConnection);
    procedure Close;
    procedure Save;
    procedure InitBills;

    // 计算 -- 均采用增量汇总方式计算父项
   {procedure Calculate(ABillsID: Integer);
    procedure CalculateDeal(ABillsID: Integer);           // 合同计量
    procedure CalculateQuantityChange(ABillsID: Integer); // 数量变更计量
    procedure CalculatePriceChange(ABillsID: Integer);    // 单价变更计量}

    // 上报审核批复过程 -- 锁定数据
    procedure LockedBaseData;
    // 解锁数据
    procedure UnLockedBaseData;

    procedure DisableEvents;
    procedure EnableEvents;

    function GetMaxBillsID: Integer;

    function GetGatherTotalPrice(ABillsID, AIndex: Integer): Double;

    property ProjectData: TObject read FProjectData;
    property StageData: TStageData read GetStageData;

    {累计完成 可查数据}
    // AIndex表示不同类型，取值如下:
    // 0: 0号台账合同 1: 累计合同计量 2: 累计数量变更计量 3: 累计单价变更计量 4: 累计完成计量
    // 第一部分
    property FirstPart[AIndex: Integer]: Double read GetFirstPart;
    // 第二部分
    property SecondPart[AIndex: Integer]: Double read GetSecondPart;
    // 第三部分
    property ThirdPart[AIndex: Integer]: Double read GetThirdPart;
    // 预留费用
    property ReservedFee[AIndex: Integer]: Double read GetReservedFee;
    // 其他费用项目
    property OtherFee[AIndex: Integer]: Double read GetOtherFee;
    // 建设期贷款利息
    property BuildLoadInterest[AIndex: Integer]: Double read GetBuildLoadInterest;
    // 回收金额
    property RecyclingFee[AIndex: Integer]: Double read GetRecyclingFee;
    // 公路工程以外的工程费用
    property OtherProjectFee[AIndex: Integer]: Double read GetOtherProjectFee;
    // 结算价
    property Settlement[AIndex: Integer]: Double read GetStageSettlement;
  end;

implementation

uses
  Variants, UtilMethods, Globals, ProjectData, ExcelImport, BillsCommand,
  PhaseData, BillsCompileDm, ConditionalDefines, FormulaCalc;

{$R *.dfm}

{ TBillsData }

procedure TBillsData.Close;
begin
  sddBills.Close;
end;

constructor TBillsData.Create(AProjectData: TObject);
begin
  inherited Create(nil);
  FProjectData := AProjectData;
end;

destructor TBillsData.Destroy;
begin
  inherited;
end;

procedure TBillsData.Open(AConnection: TADOConnection);
begin
  sdpBills.Connection := AConnection;
  sddBills.Open;
  if not Assigned(sddBills.IndexList.FindByName('idxID')) then
    sddBills.AddIndex('idxID', 'ID');
    
  sddBills.FieldByName('OrgQuantity').ValidChars := sddBills.FieldByName('Quantity').ValidChars + ArithmeticCharSet;
  sddBills.FieldByName('OrgTotalPrice').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars;
  sddBills.FieldByName('MisQuantity').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars;
  sddBills.FieldByName('MisTotalPrice').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars;
  sddBills.FieldByName('OthQuantity').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars;
  sddBills.FieldByName('OthTotalPrice').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars;
end;

procedure TBillsData.Save;

  procedure ResolveCode(ARec: TsdDataRecord);
  var
    sgs: TStrings;
    i: Integer;
    sXiangCode, sMuCode, sJieCode, sXiMuCode: string;
  begin
    sgs := TStringList.Create;
    try
      sgs.Delimiter := '-';
      sgs.DelimitedText := ARec.ValueByName('Code').AsString;
      case sgs.Count of
        1: sXiangCode := '';
        2: sXiangCode := ChinessNum(StrToIntDef(sgs[1], 0));
        3: sMuCode := sgs[2];
        4: sJieCode := sgs[3];
        else
        begin
          for i := 4 to sgs.Count - 1 do
            if sXiMuCode = '' then
              sXiMuCode := sgs[i]
            else
              sXiMuCode := sXiMuCode + '-' + sgs[i];
        end;
      end;
    finally
      if (ARec.ValueByName('XiangCode').AsString <> sXiangCode) then
        ARec.ValueByName('XiangCode').AsString := sXiangCode;
      if (ARec.ValueByName('MuCode').AsString <> sMuCode) then
        ARec.ValueByName('MuCode').AsString := sMuCode;
      if (ARec.ValueByName('JieCode').AsString <> sJieCode) then
        ARec.ValueByName('JieCode').AsString := sJieCode;
      if (ARec.ValueByName('XiMuCode').AsString <> sXiMuCode) then
        ARec.ValueByName('XiMuCode').AsString := sXiMuCode;
      sgs.Free;
    end;
  end;

  procedure SaveReportsRela;
  var
    iIndex: Integer;
    stnNode: TsdIDTreeNode;
    iLeafXmjParentID: Integer;
    sIndexCode: string;
  begin
    sddBills.BeginUpdate;
    try
      with TProjectData(FProjectData).BillsCompileData do
        for iIndex := 0 to BillsCompileTree.Count - 1 do
        begin
          stnNode := BillsCompileTree.Items[iIndex];
          // 分项清单排序
          if (stnNode.Rec.ValueByName('SerialNo').AsString = '') or
              (stnNode.MajorIndex <> stnNode.Rec.ValueByName('SerialNo').AsInteger) then
            stnNode.Rec.ValueByName('SerialNo').AsInteger := stnNode.MajorIndex;

          // 叶子节点
          if (stnNode.Rec.ValueByName('IsLeaf').asBoolean <> not stnNode.HasChildren) then
            stnNode.Rec.ValueByName('IsLeaf').AsBoolean := not stnNode.HasChildren;

          // 最底项目节父节点ID
          if (stnNode.Rec.ValueByName('B_Code').AsString <> '') then
            iLeafXmjParentID := GetLeafXmjParentID(stnNode.ID)
          else
            iLeafXmjParentID := -1;
          if (stnNode.Rec.ValueByName('LeafXmjParentID').AsInteger <> iLeafXmjParentID) then
            stnNode.Rec.ValueByName('LeafXmjParentID').AsInteger := iLeafXmjParentID;

          // 分解项目节编号为项、目、节、细目
          if stnNode.Rec.ValueByName('Code').AsString <> '' then
            ResolveCode(stnNode.Rec);

          // 工程量清单排序Code
          if (stnNode.Rec.ValueByName('B_Code').AsString <> '') then
          begin
            sIndexCode := B_CodeToIndexCode(stnNode.Rec.ValueByName('B_Code').AsString);
            if (stnNode.Rec.ValueByName('IndexCode').AsString <> sIndexCode) then
              stnNode.Rec.ValueByName('IndexCode').AsString := sIndexCode;
          end;
        end;
    finally
      sddBills.EndUpdate;
    end;
  end;

begin
  if TProjectData(FProjectData).BillsCompileData.Active then
    SaveReportsRela; // 保存 SerialNo, IsLeaf, LeafXmjParentID, 分解Code
  sddBills.Save;
end;

{procedure TBillsData.Calculate(ABillsID: Integer);
var
  stnNode: TsdIDTreeNode;
  iChild: Integer;
begin
  stnNode := FBillsTree.FindNode(ABillsID);
  if stnNode.HasChildren then
  begin
    for iChild := 0 to stnNode.ChildCount - 1 do
      Calculate(stnNode.ChildNodes[iChild].ID);
  end
  else
  begin
    CalculateOrg(ABillsID);
    CalculateDeal(ABillsID);
    CalculateQuantityChange(ABillsID);
    CalculatePriceChange(ABillsID);
  end;
end;

procedure TBillsData.CalculateDeal(ABillsID: Integer);
var
  iIndex: Integer;
  fQuantity, fTotalPrice: Double;
  Rec: TsdDataRecord;
begin
  fQuantity := 0;
  fTotalPrice := 0;
  with TProjectData(FProjectData) do
    for iIndex := 0 to PhaseCount - 1 do
    begin
      Rec := PhaseData[iIndex].PhaseRecord(ABillsID);
      if not Assigned(Rec) then Continue;
      fQuantity := fQuantity + Rec.ValueByName('DealQuantity').AsFloat;
      fTotalPrice := fTotalPrice + Rec.ValueByName('DealTotalPrice').AsFloat;
    end;
  with FBillsTree.FindNode(ABillsID).Rec do
    UpdateRecordDeal(ABillsID, fQuantity - ValueByName('AddDealQuantity').AsFloat,
      fTotalPrice - ValueByName('AddDealTotalPrice').AsFloat);
end;

procedure TBillsData.CalculatePriceChange(ABillsID: Integer);
var
  iIndex: Integer;
  fQuantity, fTotalPrice: Double;
  Rec: TsdDataRecord;
begin
  fQuantity := 0;
  fTotalPrice := 0;
  with TProjectData(FProjectData) do
    for iIndex := 0 to PhaseCount - 1 do
    begin
      Rec := PhaseData[iIndex].PhaseRecord(ABillsID);
      if not Assigned(Rec) then Continue;
      fQuantity := fQuantity + Rec.ValueByName('PcQuantity').AsFloat;
      fTotalPrice := fTotalPrice + Rec.ValueByName('PcTotalPrice').AsFloat;
    end;
  with FBillsTree.FindNode(ABillsID).Rec do
    UpdateRecordPc(ABillsID, fQuantity - ValueByName('AddPcQuantity').AsFloat,
      fTotalPrice - ValueByName('AddPcTotalPrice').AsFloat);
end;

procedure TBillsData.CalculateQuantityChange(ABillsID: Integer);
var
  iIndex: Integer;
  fQuantity, fTotalPrice: Double;
  Rec: TsdDataRecord;
begin
  fQuantity := 0;
  fTotalPrice := 0;
  with TProjectData(FProjectData) do
    for iIndex := 0 to PhaseCount - 1 do
    begin
      Rec := PhaseData[iIndex].PhaseRecord(ABillsID);
      if not Assigned(Rec) then Continue;
      fQuantity := fQuantity + Rec.ValueByName('QcQuantity').AsFloat;
      fTotalPrice := fTotalPrice + Rec.ValueByName('QcTotalPrice').AsFloat;
    end;
  with FBillsTree.FindNode(ABillsID).Rec do
    UpdateRecordQc(ABillsID, fQuantity - ValueByName('AddQcQuantity').AsFloat,
      fTotalPrice - ValueByName('AddQcTotalPrice').AsFloat);
end; }

{
procedure TBillsData.RecursiveCalculate(ABillsID: Integer);

  procedure GatherChildValue(ANode: TsdIDTreeNode);
  var
    CacheRecord: TCacheRecord;
    iChild: Integer;
  begin
    CacheRecord := TCacheRecord.Create;
    try
      for iChild := 0 to ANode.ChildCount - 1 do
        with ANode.ChildNodes[iChild].Rec do
        begin
          CacheRecord.FTotalPrice := CacheRecord.FTotalPrice + ValueByName('TotalPrice').AsFloat;
          CacheRecord.FDealQuantity := CacheRecord.FDealQuantity + ValueByName('AddDealQuantity').AsFloat;
          CacheRecord.FDealTotalPrice := CacheRecord.FDealTotalPrice + ValueByName('AddDealTotalPrice').AsFloat;
          CacheRecord.FQcQuantity := CacheRecord.FQcQuantity + ValueByName('AddQcQuantity').AsFloat;
          CacheRecord.FQcTotalPrice := CacheRecord.FQcTotalPrice + ValueByName('AddQcTotalPrice').AsFloat;
          CacheRecord.FPcQuantity := CacheRecord.FPcQuantity + ValueByName('AddPcQuantity').AsFloat;
          CacheRecord.FPcTotalPrice := CacheRecord.FPcTotalPrice + ValueByName('AddPcTotalPrice').AsFloat;
        end;
    finally
      CacheRecord.SetBillsRecord(ANode);
      CacheRecord.Free;
    end;
  end;

  procedure CalculateLeafNode(ANode: TsdIDTreeNode; ACacheRecord: TCacheRecord);
  begin
    with ANode.Rec do
    begin
      if ValueByName('QtyFlag').AsInteger = 1 then
        ValueByName('Quantity').AsFloat := EvaluateExprs(ValueByName('QtyFormula').AsString);
      if ValueByName('QtyFlag').AsInteger < 2 then
        ACacheRecord.FTotalPrice := ValueByName('Quantity').AsFloat * ValueByName('Price').AsFloat
      else
      begin
        FFormulaCalc.SetRecordText(ValueByName('QtyFormula').AsString);
        ACacheRecord.FTotalPrice := FFormulaCalc.Value;
      end;
    end;
  end;

  procedure GatherPhaseValue(ANode: TsdIDTreeNode);
  var
    CacheRecord: TCacheRecord;
    iIndex: Integer;
    Rec: TsdDataRecord;
  begin
    CacheRecord := TCacheRecord.Create;
    try
      CalculateLeafNode(ANode, CacheRecord);
      {with TProjectData(FProjectData) do
        for iIndex := 0 to PhaseCount - 1 do
        begin
          PhaseData[iIndex].ReCalculate(ANode.ID);
          Rec := PhaseData[iIndex].PhaseRecord(ANode.ID);
          if not Assigned(Rec) then Continue;
          CacheRecord.FDealQuantity := CacheRecord.FDealQuantity + Rec.ValueByName('DealQuantity').AsFloat;
          CacheRecord.FDealTotalPrice := CacheRecord.FDealTotalPrice + Rec.ValueByName('DealTotalPrice').AsFloat;
          CacheRecord.FQcQuantity := CacheRecord.FQcQuantity + Rec.ValueByName('QcQuantity').AsFloat;
          CacheRecord.FQcTotalPrice := CacheRecord.FQcTotalPrice + Rec.ValueByName('QcTotalPrice').AsFloat;
          CacheRecord.FPcQuantity := CacheRecord.FPcQuantity + Rec.ValueByName('PcQuantity').AsFloat;
          CacheRecord.FPcTotalPrice := CacheRecord.FPcTotalPrice + Rec.ValueByName('PcTotalPrice').AsFloat;
        end;}
{    finally
      CacheRecord.SetBillsRecord(ANode);
      CacheRecord.Free;
    end;
  end;

  procedure CalculateCurNode(ANode: TsdIDTreeNode);
  begin
    if ANode.HasChildren then
      GatherChildValue(ANode)
    else
      GatherPhaseValue(ANode);
  end;

  procedure CalculateAllChildren(ANode: TsdIDTreeNode);
  var
    iChild: Integer;
  begin
    if ANode.HasChildren then
      for iChild := 0 to ANode.ChildCount - 1 do
        RecursiveCalculate(ANode.ChildNodes[iChild].ID);
  end;

var
  stnNode: TsdIDTreeNode;
begin
  stnNode := FBillsTree.FindNode(ABillsID);
  CalculateAllChildren(stnNode);
  CalculateCurNode(stnNode);
end;  }

procedure TBillsData.InitBills;
var
  Import: TBillsExcelImport;
begin
  Import := TBillsExcelImport.Create(TProjectData(ProjectData));
  try
    Import.ImportFile(GetTemplateBillsFileName);
  finally
    Import.Free;
  end;
end;

function TBillsData.GetStageData: TStageData;
begin
  Result := TProjectData(FProjectData).PhaseData.StageData;
end;

procedure TBillsData.LockedBaseData;
var
  iIndex: Integer;
begin
  sddBills.BeginUpdate;
  for iIndex := 0 to sddBills.RecordCount - 1 do
  begin
    if not sddBills.Records[iIndex].ValueByName('LockedLevel').AsBoolean then
      sddBills.Records[iIndex].ValueByName('LockedLevel').AsBoolean := True;
    if not sddBills.Records[iIndex].ValueByName('LockedInfo').AsBoolean then
      sddBills.Records[iIndex].ValueByName('LockedInfo').AsBoolean := True;
    if sddBills.Records[iIndex].ValueByName('NewPrice').AsFloat <> 0 then
      sddBills.Records[iIndex].ValueByName('LockedNewPrice').AsBoolean := True;
  end;
  sddBills.EndUpdate;
end;

procedure TBillsData.sddBillsAfterAddRecord(ARecord: TsdDataRecord);
begin
  ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).PhaseIndex;
end;

function TBillsData.GetBuildLoadInterest(AIndex: Integer): Double;
begin
  Result := GetGatherTotalPrice(34, AIndex);
end;

function TBillsData.GetFirstPart(AIndex: Integer): Double;
begin
  Result := GetGatherTotalPrice(1, AIndex);
end;

function TBillsData.GetOtherFee(AIndex: Integer): Double;
begin
  Result := GetGatherTotalPrice(15, AIndex);
end;

function TBillsData.GetOtherProjectFee(AIndex: Integer): Double;
begin
  Result := GetGatherTotalPrice(9, AIndex);
end;

function TBillsData.GetRecyclingFee(AIndex: Integer): Double;
begin
  Result := GetGatherTotalPrice(16, AIndex);
end;

function TBillsData.GetReservedFee(AIndex: Integer): Double;
begin
  Result := GetGatherTotalPrice(7, AIndex);
end;

function TBillsData.GetSecondPart(AIndex: Integer): Double;
begin
  Result := GetGatherTotalPrice(2, AIndex);
end;

function TBillsData.GetStageSettlement(AIndex: Integer): Double;
begin
  // 全国
  // 第一部分+第二部分+第三部分+预备费+新增加费用项目(其他费用_广东)-回收金额
  Result := FirstPart[AIndex] + SecondPart[AIndex] + ThirdPart[AIndex]
         + ReservedFee[AIndex] + OtherFee[AIndex] - RecyclingFee[AIndex];
  // 广东
  // 全国的基础上+建设期贷款利息+公路功能以外的项目
  if _IsGuangDong then
    Result := Result + BuildLoadInterest[AIndex] + OtherProjectFee[AIndex];
end;

function TBillsData.GetThirdPart(AIndex: Integer): Double;
begin
  Result := GetGatherTotalPrice(3, AIndex);
end;

function TBillsData.GetGatherTotalPrice(ABillsID, AIndex: Integer): Double;
var
  Rec: TsdDataRecord;
begin
  Result := 0;
  Rec := sddBills.FindKey('idxID', ABillsID);
  if Assigned(Rec) then
  begin
    case AIndex of
      0: Result := Rec.ValueByName('TotalPrice').AsFloat;
      1: Result := Rec.ValueByName('AddDealTotalPrice').AsFloat;
      2: Result := Rec.ValueByName('AddQcTotalPrice').AsFloat;
      3: Result := Rec.ValueByName('AddPcTotalPrice').AsFloat;
      4: Result := Rec.ValueByName('AddGatherTotalPrice').AsFloat;
    end;
  end;
end;

procedure TBillsData.DisableEvents;
begin
  sddBills.BeforeValueChange := nil;
  sddBills.AfterValueChanged := nil;
end;

procedure TBillsData.EnableEvents;
begin
  {sddBills.BeforeValueChange := sddBillsBeforeValueChange;
  sddBills.AfterValueChanged := sddBillsAfterValueChanged;}
end;

procedure TBillsData.UnLockedBaseData;
var
  iIndex: Integer;
begin
  for iIndex := 0 to sddBills.RecordCount - 1 do
    sddBills.Records[iIndex].ValueByName('LockedInfo').AsBoolean := False;
end;

procedure TBillsData.sddBillsBeforeDeleteRecord(ARecord: TsdDataRecord;
  var Allow: Boolean);
begin
  with TProjectData(FProjectData) do
  begin
    if ProjProperties.PhaseCount > 0 then
      PhaseData.StageData.DeletePhaseRecord(ARecord.ValueByName('ID').AsInteger);
  end;
end;

procedure TBillsData.sddBillsBeforeValueChange(AValue: TsdValue;
  const NewValue: Variant; var Allow: Boolean);
begin
  if (Pos('DgnQuantity', AValue.FieldName) > 0) and
     not (VarIsNull(NewValue) or (NewValue = 0)) then
  begin
    if AValue.Owner.ValueByName('B_Code').AsString <> '' then
    begin
      ErrorMessage('仅项目节可以输入设计数量！');
      Allow := False;
    end;
  end;
end;

function TBillsData.GetMaxBillsID: Integer;
var
  Rec: TsdDataRecord;
  i: Integer;
begin
  Result := 100;
  for i := 0 to sddBills.RecordCount - 1 do
  begin
    Rec := sddBills.Records[i];
    if Rec.ValueByName('ID').AsInteger > Result then
      Result := Rec.ValueByName('ID').AsInteger;
  end;
end;

procedure TBillsData.sddBillsGetRecordClass(
  var ARecordClass: TsdRecordClass);
begin
  ARecordClass := TBillsRecord;
end;

end.