Measure/DataModules/ReportMemoryDm/rmCustomized2Dm.pas

unit rmCustomized2Dm;
// 广东肇庆定制 -- 汇总表（计量汇总表）
// 严禁任何其他项目使用该单元

interface

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

type
  TTenderBaseData = class
  private
    FTenderName: string;
    FTotalPrice: Double;
    FEndCTotalPrice: Double;
    FCurDealTotalPrice: Double;
    FPreDealTotalPrice: Double;
    FEndDealTotalPrice: Double;
    function GetEndGatherTotalPrice: Double;
    function GetPrecent: Double;
  public
    constructor Create(const ATenderName: string);

    property TenderName: string read FTenderName;
    property TotalPrice: Double read FTotalPrice write FTotalPrice;
    property EndCTotalPrice: Double read FEndCTotalPrice write FEndCTotalPrice;
    property EndGatherTotalPrice: Double read GetEndGatherTotalPrice;

    property CurDealTotalPrice: Double read FCurDealTotalPrice write FCurDealTotalPrice;
    property PreDealTotalPrice: Double read FPreDealTotalPrice write FPreDealTotalPrice;
    property EndDealTotalPrice: Double read FEndDealTotalPrice write FEndDealTotalPrice;

    property Precent: Double read GetPrecent;
  end;

  TDealPayData = class
  private
    FName: string;
    FCurTotalPrice: Double;
    FPreTotalPrice: Double;
    FEndTotalPrice: Double;
  public
    constructor Create(const AName: string);

    property Name: string read FName;

    property CurTotalPrice: Double read FCurTotalPrice write FCurTotalPrice;
    property PreTotalPrice: Double read FPreTotalPrice write FPreTotalPrice;
    property EndTotalPrice: Double read FEndTotalPrice write FEndTotalPrice;
  end;

  TGatherData = class
  private
    FTenders: TList;
    FTenderGather: TTenderBaseData;
    FDealPays: TList;
    FPayGather: TDealPayData;

    function FindDealPay(const AName: string): TDealPayData;

    function GetTenderCount: Integer;
    function GetTenders(AIndex: Integer): TTenderBaseData;
    function GetDealPay(AIndex: Integer): TDealPayData;
    function GetDealPayCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    function AddTender(const ATenderName: string): TTenderBaseData;
    procedure GatherTender;
    function AddDealPay(const AName: string): TDealPayData;

    property TenderCount: Integer read GetTenderCount;
    property Tenders[AIndex: Integer]: TTenderBaseData read GetTenders;
    property TenderGather: TTenderBaseData read FTenderGather;
    property DealPayCount: Integer read GetDealPayCount;
    property DealPay[AIndex: Integer]: TDealPayData read GetDealPay;
    property PayGather: TDealPayData read FPayGather;
  end;

  TrmCustomized2Data = class(TDataModule)
    cdsCustom: TClientDataSet;
    cdsCustomSerialNo: TIntegerField;
    cdsCustomName: TWideStringField;
    cdsCustomTotalPrice: TFloatField;
    cdsCustomEndCTotalPrice: TFloatField;
    cdsCustomEndGatherTotalPrice: TFloatField;
    cdsCustomCurDealTotalPrice: TFloatField;
    cdsCustomPreDealTotalPrice: TFloatField;
    cdsCustomEndDealTotalPrice: TFloatField;
    cdsCustomPrecent: TFloatField;
  private
    FProjectData: TProjectData;
    FProjectName: string;
    FGatherData: TGatherData;
    FSerialNo: Integer;

    procedure BeforeGather;
    procedure AfterGather;

    procedure OpenProjectData(AProject: TSelectProject);
    procedure FreeProjectData;

    procedure GatherProject(AProject: TSelectProject);

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

implementation

uses
  DealPaymentDm, PhasePayDm, Globals, UtilMethods;

{$R *.dfm}

{ TTenderBaseData }

constructor TTenderBaseData.Create(const ATenderName: string);
begin
  FTenderName := ATenderName;
  FTotalPrice := 0;
  FEndCTotalPrice := 0;
  FCurDealTotalPrice := 0;
  FPreDealTotalPrice := 0;
  FEndDealTotalPrice := 0;
end;

function TTenderBaseData.GetEndGatherTotalPrice: Double;
begin
  Result := TotalPrice + EndCTotalPrice;
end;

function TTenderBaseData.GetPrecent: Double;
begin
  if EndGatherTotalPrice <> 0 then
    Result := EndDealTotalPrice/EndGatherTotalPrice*100
  else
    Result := 0;
end;

{ TGatherData }

function TGatherData.AddDealPay(const AName: string): TDealPayData;
begin
  Result := FindDealPay(AName);
  if not Assigned(Result) then
  begin
    Result := TDealPayData.Create(AName);
    FDealPays.Add(Result);
  end;
end;

function TGatherData.AddTender(const ATenderName: string): TTenderBaseData;
begin
  Result := TTenderBaseData.Create(ATenderName);
  FTenders.Add(Result);
end;

constructor TGatherData.Create;
begin
  FTenders := TList.Create;
  FTenderGather := TTenderBaseData.Create('合计');
  FDealPays := TList.Create;
  FPayGather := TDealPayData.Create('支付');
end;

destructor TGatherData.Destroy;
begin
  FPayGather.Free;
  ClearObjects(FDealPays);
  FDealPays.Free;
  FTenderGather.Free;
  ClearObjects(FTenders);
  FTenders.Free;
  inherited;
end;

function TGatherData.FindDealPay(const AName: string): TDealPayData;
var
  iIndex: Integer;
begin
  Result := nil;
  for iIndex := 0 to DealPayCount - 1 do
  begin
    if SameText(AName, DealPay[iIndex].Name) then
    begin
      Result := DealPay[iIndex];
      Break;
    end;
  end;
end;

procedure TGatherData.GatherTender;
var
  iIndex: Integer;
  Tender: TTenderBaseData;
begin
  FTenderGather.TotalPrice := 0;
  FTenderGather.EndCTotalPrice := 0;
  FTenderGather.CurDealTotalPrice := 0;
  FTenderGather.PreDealTotalPrice := 0;
  FTenderGather.EndDealTotalPrice := 0;

  for iIndex := 0 to FTenders.Count - 1 do
  begin
    Tender := Tenders[iIndex];
    FTenderGather.TotalPrice := FTenderGather.TotalPrice + Tender.TotalPrice;
    FTenderGather.EndCTotalPrice := FTenderGather.EndCTotalPrice + Tender.FEndCTotalPrice;
    FTenderGather.CurDealTotalPrice := FTenderGather.CurDealTotalPrice + Tender.CurDealTotalPrice;
    FTenderGather.PreDealTotalPrice := FTenderGather.PreDealTotalPrice + Tender.PreDealTotalPrice;
    FTenderGather.EndDealTotalPrice := FTenderGather.EndDealTotalPrice + Tender.EndDealTotalPrice;
  end;
end;

function TGatherData.GetDealPay(AIndex: Integer): TDealPayData;
begin
  Result := TDealPayData(FDealPays.Items[AIndex]);
end;

function TGatherData.GetDealPayCount: Integer;
begin
  Result := FDealPays.Count;
end;

function TGatherData.GetTenderCount: Integer;
begin
  Result := FTenders.Count;
end;

function TGatherData.GetTenders(AIndex: Integer): TTenderBaseData;
begin
  Result := TTenderBaseData(FTenders.Items[AIndex]);
end;

{ TDealPayData }

constructor TDealPayData.Create(const AName: string);
begin
  FName := AName;
  FCurTotalPrice := 0;
  FPreTotalPrice := 0;
  FEndTotalPrice := 0;
end;

{ TrmCustomized2Data }

procedure TrmCustomized2Data.AfterGather;
begin
  FGatherData.Free;
end;

function TrmCustomized2Data.AssignData(AProjects: TList): TDataSet;
var
  iProject: Integer;
begin
  BeforeGather;
  try
    for iProject := 0 to AProjects.Count - 1 do
      GatherProject(TSelectProject(AProjects.Items[iProject]));
    FGatherData.GatherTender;
    WriteData;
  finally
    Result := cdsCustom;
    AfterGather;
  end;
end;

procedure TrmCustomized2Data.BeforeGather;
begin
  cdsCustom.Active := True;
  cdsCustom.EmptyDataSet;
  FGatherData := TGatherData.Create;
end;

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

procedure TrmCustomized2Data.GatherProject(AProject: TSelectProject);
var
  sCurField, sPreField, sEndField: string;

  function DealPayRecord(const AName: string): TsdDataRecord;
  var
    iRec: Integer;
    Rec: TsdDataRecord;
  begin
    Result := nil;
    with FProjectData.DealPaymentData do
    begin
      for iRec := 0 to sddDealPayment.RecordCount - 1 do
      begin
        Rec := sddDealPayment.Records[iRec];
        if SameText(AName, Rec.ValueByName('Name').AsString) then
        begin
          Result := Rec;
          Break;
        end;
      end;
    end;
  end;

  procedure GatherBaseData;
  var
    TenderBase: TTenderBaseData;
    Rec, StageRec: TsdDataRecord;
  begin
    TenderBase := FGatherData.AddTender(FProjectName);
    TenderBase.TotalPrice := FProjectData.BillsData.Settlement[0];
    TenderBase.EndCTotalPrice := FProjectData.BillsData.Settlement[2];
    Rec := DealPayRecord('本期完成计量');
    StageRec := FProjectData.PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger);
    TenderBase.CurDealTotalPrice := StageRec.ValueByName(sCurField).AsFloat;
    TenderBase.PreDealTotalPrice := StageRec.ValueByName(sPreField).AsFloat;
    TenderBase.EndDealTotalPrice := StageRec.ValueByName(sEndField).AsFloat;
  end;

  procedure GatherCommonDealPayData;
  var
    iRec: Integer;
    Rec, StageRec: TsdDataRecord;
    DealPay: TDealPayData;
  begin
    with FProjectData.DealPaymentData do
    begin
      for iRec := 0 to sddDealPayment.RecordCount - 1 do
      begin
        Rec := sddDealPayment.Records[iRec];
        if SameText(Rec.ValueByName('Name').AsString, '本期完成计量') or
           SameText(Rec.ValueByName('Name').AsString, '本期应付') or
           SameText(Rec.ValueByName('Name').AsString, '本期实付') then
          Continue;
        StageRec := FProjectData.PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger);
        if StageRec.ValueByName(sEndField).AsFloat = 0 then
          Continue;
        DealPay := FGatherData.AddDealPay(Rec.ValueByName('Name').AsString);
        DealPay.CurTotalPrice := DealPay.CurTotalPrice + StageRec.ValueByName(sCurField).AsFloat;
        DealPay.PreTotalPrice := DealPay.PreTotalPrice + StageRec.ValueByName(sPreField).AsFloat;
        DealPay.EndTotalPrice := DealPay.EndTotalPrice + StageRec.ValueByName(sEndField).AsFloat;
      end;
    end;
  end;

  procedure GatherPayData;
  var
    Rec, StageRec: TsdDataRecord;
  begin
    Rec := DealPayRecord('本期应付');
    StageRec := FProjectData.PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger);
    with FGatherData.PayGather do
    begin
      CurTotalPrice := CurTotalPrice + StageRec.ValueByName(sCurField).AsFloat;
      PreTotalPrice := PreTotalPrice + StageRec.ValueByName(sPreField).AsFloat;
      EndTotalPrice := EndTotalPrice + StageRec.ValueByName(sEndField).AsFloat;
    end;
  end;

begin
  OpenProjectData(AProject);
  try
    sCurField := 'TotalPrice' + IntToStr(FProjectData.PhaseData.AuditCount);
    sPreField := 'PreTotalPrice' + IntToStr(FProjectData.PhaseData.AuditCount);
    sEndField := 'EndTotalPrice' + IntToStr(FProjectData.PhaseData.AuditCount);
    GatherBaseData;
    GatherCommonDealPayData;
    GatherPayData;
  finally
    FreeProjectData;
  end;
end;

procedure TrmCustomized2Data.OpenProjectData(AProject: TSelectProject);
var
  Rec: TsdDataRecord;
begin
  FProjectData := OpenProjectManager.FindProjectData(AProject.ProjectID);
  Rec := ProjectManager.sddProjectsInfo.FindKey('idxID', AProject.ProjectID);
  if not Assigned(FProjectData) then
  begin
    FProjectData := TProjectData.Create;
    FProjectData.OpenForReport2(GetMyProjectsFilePath + Rec.ValueByName('FileName').AsString);
  end;
  FProjectName := Rec.ValueByName('Name').AsString;
end;

procedure TrmCustomized2Data.WriteData;

  procedure WriteProjectData;
  var
    i: Integer;
    Tender: TTenderBaseData;
  begin
    for i := 0 to FGatherData.TenderCount - 1 do
    begin
      Tender := FGatherData.Tenders[i];
      cdsCustom.Append;
      cdsCustomSerialNo.AsInteger := FSerialNo;
      cdsCustomName.AsString := Tender.TenderName;
      cdsCustomTotalPrice.AsFloat := Tender.TotalPrice;
      cdsCustomEndCTotalPrice.AsFloat := Tender.EndCTotalPrice;
      cdsCustomEndGatherTotalPrice.AsFloat := Tender.EndGatherTotalPrice;
      cdsCustomCurDealTotalPrice.AsFloat := Tender.CurDealTotalPrice;
      cdsCustomPreDealTotalPrice.AsFloat := Tender.PreDealTotalPrice;
      cdsCustomEndDealTotalPrice.AsFloat := Tender.EndDealTotalPrice;
      cdsCustomPrecent.AsFloat := Tender.Precent;
      cdsCustom.Post;
      Inc(FSerialNo);
    end;
  end;

  procedure WriteProjectGather;
  begin
    cdsCustom.Append;
    cdsCustomName.AsString := FGatherData.TenderGather.TenderName;
    cdsCustomTotalPrice.AsFloat := FGatherData.TenderGather.TotalPrice;
    cdsCustomEndCTotalPrice.AsFloat := FGatherData.TenderGather.EndCTotalPrice;
    cdsCustomEndGatherTotalPrice.AsFloat := FGatherData.TenderGather.EndGatherTotalPrice;
    cdsCustomCurDealTotalPrice.AsFloat := FGatherData.TenderGather.CurDealTotalPrice;
    cdsCustomPreDealTotalPrice.AsFloat := FGatherData.TenderGather.PreDealTotalPrice;
    cdsCustomEndDealTotalPrice.AsFloat := FGatherData.TenderGather.EndDealTotalPrice;
    cdsCustomPrecent.AsFloat := FGatherData.TenderGather.Precent;
    cdsCustom.Post;
  end;

  procedure WriteDealPays;
  var
    i: Integer;
    DealPay: TDealPayData;
  begin
    for i := 0 to FGatherData.DealPayCount - 1 do
    begin
      DealPay := FGatherData.DealPay[i];
      cdsCustom.Append;
      cdsCustomSerialNo.AsInteger := FSerialNo;
      cdsCustomName.AsString := DealPay.Name;
      cdsCustomCurDealTotalPrice.AsFloat := DealPay.CurTotalPrice;
      cdsCustomPreDealTotalPrice.AsFloat := DealPay.PreTotalPrice;
      cdsCustomEndDealTotalPrice.AsFloat := DealPay.EndTotalPrice;
      cdsCustom.Post;
      Inc(FSerialNo);
    end;
  end;

  procedure WriteGatherPay;
  begin
    cdsCustom.Append;
    cdsCustomSerialNo.AsInteger := FSerialNo;
    cdsCustomName.AsString := FGatherData.PayGather.Name;
    cdsCustomCurDealTotalPrice.AsFloat := FGatherData.PayGather.CurTotalPrice;
    cdsCustomPreDealTotalPrice.AsFloat := FGatherData.PayGather.PreTotalPrice;
    cdsCustomEndDealTotalPrice.AsFloat := FGatherData.PayGather.EndTotalPrice;
    cdsCustom.Post;
  end;

begin
  FSerialNo := 1;
  WriteProjectData;
  WriteProjectGather;
  WriteDealPays;
  WriteGatherPay;
end;

end.