Measure/DataModules/ReportMemoryDm/rmBGBillsGatherDm.pas

unit rmBGBillsGatherDm;

interface

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

type
  TBGBills = class
  private
    FIndexCode: string;
    FB_Code: string;
    FName: string;
    FUnits: string;
    FPrice: Double;
    FQuantity: Double;
    FTotalPrice: Double;
    FCurQuantity: Double;
    FCurTotalPrice: Double;
    FPreQuantity: Double;
    FPreTotalPrice: Double;
    FEndQuantity:  Double;
    FEndTotalPrice: Double;
    procedure SetB_Code(const Value: string);
    function GetPercent: Double;
  public
    procedure Calcualte;

    property B_Code: string read FB_Code write SetB_Code;
    property IndexCode: string read FIndexCode;
    property Name: string read FName write FName;
    property Units: string read FUnits write FUnits;
    property Price: Double read FPrice write FPrice;
    property Quantity: Double read FQuantity write FQuantity;
    property TotalPrice: Double read FTotalPrice write FTotalPrice;
    property CurQuantity: Double read FCurQuantity write FCurQuantity;
    property CurTotalPrice: Double read FCurTotalPrice;
    property PreQuantity: Double read FPreQuantity write FPreQuantity;
    property PreTotalPrice: Double read FPreTotalPrice;
    property EndQuantity: Double read FEndQuantity;
    property EndTotalPrice: Double read FEndTotalPrice;
    property Percent: Double read GetPercent;
  end;

  TBGLData = class
  private
    FBGLCode: string;
    FBGBillsList: TList;
    function GetBGBills(AIndex: Integer): TBGBills;
    function GetBGBillsCount: Integer;
  public
    constructor Create(const ACode: string);
    destructor Destroy; override;

    function AddBGBills: TBGBills;
    function FindBGBills(const AB_Code: string): TBGBills;

    procedure Calculate;

    property BGLCode: string read FBGLCode;

    property BGBills[AIndex: Integer]: TBGBills read GetBGBills;
    property BGBillsCount: Integer read GetBGBillsCount;
  end;

  TTenderData = class
  private
    FSerialNo: Integer;
    FID: Integer;
    FName: String;
    FBGLs: TList;

    FTotalPrice: Double;
    FCurTotalPrice: Double;
    FPreTotalPrice: Double;
    FEndTotalPrice: Double;

    function GetBGLCount: Integer;
    function GetBGLData(AIndex: Integer): TBGLData;
    function GetPercent: Double;
  public
    constructor Create(ASerialNo, AID: Integer; const AName: string);
    destructor Destroy; override;

    procedure Calculate;
    function AddBGL(const ACode: string): TBGLData;
    function FindBGL(const ACode: string): TBGLData;

    property SerialNo: Integer read FSerialNo;
    property ID: Integer read FID;
    property Name: string read FName;

    property BGL[AIndex: Integer]: TBGLData read GetBGLData;
    property BGLCount: Integer read GetBGLCount;

    property TotalPrice: Double read FTotalPrice;
    property CurTotalPrice: Double read FCurTotalPrice;
    property PreTotalPrice: Double read FPreTotalPrice;
    property EndTotalPrice: Double read FEndTotalPrice;
    property Percent: Double read GetPercent;
  end;

  TGatherData = class
  private
    FTenders: TList;

    FTotalPrice: Double;
    FCurTotalPrice: Double;
    FPreTotalPrice: Double;
    FEndTotalPrice: Double;

    function GetTender(AIndex: Integer): TTenderData;
    function GetTenderCount: Integer;
    function GetPercent: Double;
  public
    constructor Create;
    destructor Destroy; override;

    function AddTender(AIndex, AID: Integer; const AName: string): TTenderData;
    procedure Calculate;

    property Tender[AIndex: Integer]: TTenderData read GetTender;
    property TenderCount: Integer read GetTenderCount;

    property TotalPrice: Double read FTotalPrice;
    property CurTotalPrice: Double read FCurTotalPrice;
    property PreTotalPrice: Double read FPreTotalPrice;
    property EndTotalPrice: Double read FEndTotalPrice;
    property Percent: Double read GetPercent;
  end;

  TrmBGBillsGatherData = class(TDataModule)
    cdsBGBills: TClientDataSet;
    cdsBGBillsTenderID: TIntegerField;
    cdsBGBillsPartID: TIntegerField;
    cdsBGBillsIndexCode: TWideStringField;
    cdsBGBillsB_Code: TWideStringField;
    cdsBGBillsName: TWideStringField;
    cdsBGBillsUnits: TWideStringField;
    cdsBGBillsPrice: TFloatField;
    cdsBGBillsQuantity: TFloatField;
    cdsBGBillsTotalPrice: TFloatField;
    cdsBGBillsCurQuantity: TFloatField;
    cdsBGBillsCurTotalPrice: TFloatField;
    cdsBGBillsPreQuantity: TFloatField;
    cdsBGBillsPreTotalPrice: TFloatField;
    cdsBGBillsEndQuantity: TFloatField;
    cdsBGBillsEndTotalPrice: TFloatField;
    cdsBGBillsPercent: TFloatField;
    cdsBGBillsBGLCode: TWideStringField;
  private
    FGatherData: TGatherData;
    FProjectName: string;
    FProjectData: TProjectData;

    procedure BeforeGather;
    procedure AfterGather;

    procedure OpenProjectData(AProject: TSelectProject; AProjectIndex: Integer);
    procedure FreeProjectData;

    procedure GatherBGBills(ABGL: TBGLData; ABGLID: Integer);
    procedure GatherBGL(ATenderData: TTenderData);
    procedure GatherMeasureData(ATenderData: TTenderData);
    procedure GatherProject(AProject: TSelectProject; AProjectIndex: Integer);

    procedure CalculateGatherData;

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

implementation

uses
  ZhAPI, UtilMethods, DateUtils, Globals, BGLDm, mDataRecord;

{$R *.dfm}

{ TGatherData }

function TGatherData.AddTender(AIndex, AID: Integer;
  const AName: string): TTenderData;
begin
  Result := TTenderData.Create(AIndex, AID, AName);
  FTenders.Add(Result);
end;

procedure TGatherData.Calculate;
var
  i: Integer;
begin
  FTotalPrice := 0;
  FCurTotalPrice := 0;
  FPreTotalPrice := 0;
  FEndTotalPrice := 0;
  for i := 0 to TenderCount - 1 do
  begin
    Tender[i].Calculate;
    FTotalPrice := FTotalPrice + Tender[i].TotalPrice;
    FCurTotalPrice := FCurTotalPrice + Tender[i].CurTotalPrice;
    FPreTotalPrice := FPreTotalPrice + Tender[i].PreTotalPrice;
    FEndTotalPrice := FEndTotalPrice + Tender[i].EndTotalPrice;
  end;
end;

constructor TGatherData.Create;
begin
  FTenders := TList.Create;
end;

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

function TGatherData.GetPercent: Double;
begin
  if FTotalPrice <> 0 then
    Result := CommonRoundTo(FEndTotalPrice / FTotalPrice * 100, -2)
  else
    Result := 0;
end;

function TGatherData.GetTender(AIndex: Integer): TTenderData;
begin
  Result := TTenderData(FTenders[AIndex]);
end;

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

{ TTenderData }

function TTenderData.AddBGL(const ACode: string): TBGLData;
begin
  Result := TBGLData.Create(ACode);
  FBGLs.Add(Result);
end;

procedure TTenderData.Calculate;
var
  i, j: Integer;
  vBGL: TBGLData;
begin
  FTotalPrice := 0;
  FPreTotalPrice := 0;
  FCurTotalPrice := 0;
  FEndTotalPrice := 0;
  for i := 0 to BGLCount - 1 do
  begin
    vBGL := BGL[i];
    vBGL.Calculate;
    for j := 0 to vBGL.BGBillsCount - 1 do
    begin
      FTotalPrice := FTotalPrice + vBGL.BGBills[j].TotalPrice;
      FCurTotalPrice := FCurTotalPrice + vBGL.BGBills[j].CurTotalPrice;
      FPreTotalPrice := FPreTotalPrice + vBGL.BGBills[j].PreTotalPrice;
      FEndTotalPrice := FEndTotalPrice + vBGL.BGBills[j].EndTotalPrice;
    end;
  end;
end;

constructor TTenderData.Create(ASerialNo, AID: Integer; const AName: string);
begin
  FSerialNo := ASerialNo;
  FID := AID;
  FName := AName;
  FBGLs := TList.Create;
end;

destructor TTenderData.Destroy;
begin
  ClearObjects(FBGLs);
  FBGLs.Free;
  inherited;
end;

function TTenderData.FindBGL(const ACode: string): TBGLData;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to BGLCount - 1 do
  begin
    if (ACode = BGL[i].BGLCode) then
    begin
      Result := BGL[i];
      Break;
    end;
  end;
end;

function TTenderData.GetBGLCount: Integer;
begin
  Result := FBGLs.Count;
end;

function TTenderData.GetBGLData(AIndex: Integer): TBGLData;
begin
  Result := TBGLData(FBGLs[AIndex]);
end;

function TTenderData.GetPercent: Double;
begin
  if FTotalPrice <> 0 then
    Result := CommonRoundTo(FEndTotalPrice / FTotalPrice * 100, -2)
  else
    Result := 0;
end;

{ TBGLData }

function TBGLData.AddBGBills: TBGBills;
begin
  Result := TBGBills.Create;
  FBGBillsList.Add(Result);
end;

procedure TBGLData.Calculate;
var
  i: Integer;
begin
  for i := 0 to BGBillsCount - 1 do
    BGBills[i].Calcualte;
end;

constructor TBGLData.Create(const ACode: string);
begin
  FBGLCode := ACode;
  FBGBillsList := TList.Create;
end;

destructor TBGLData.Destroy;
begin
  ClearObjects(FBGBillsList);
  FBGBillsList.Free;
  inherited;
end;

function TBGLData.FindBGBills(const AB_Code: string): TBGBills;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to BGBillsCount - 1 do
  begin
    if (AB_Code = BGBills[i].B_Code) then
    begin
      Result := BGBills[i];
      Break;
    end;
  end;
end;

function TBGLData.GetBGBills(AIndex: Integer): TBGBills;
begin
  Result := TBGBills(FBGBillsList[AIndex]);
end;

function TBGLData.GetBGBillsCount: Integer;
begin
  Result := FBGBillsList.Count;
end;

{ TrmBGBillsGatherData }

procedure TrmBGBillsGatherData.AfterGather;
begin
  cdsBGBills.EnableControls;
  FGatherData.Free;
end;

function TrmBGBillsGatherData.AssignData(AProjects: TList): TDataSet;
var
  iProject: Integer;
  SelectProject: TSelectProject;
begin
  BeforeGather;
  try
    for iProject := 0 to AProjects.Count - 1 do
      GatherProject(TSelectProject(AProjects.Items[iProject]), iProject);
    CalculateGatherData;
    WriteData;
  finally
    Result := cdsBGBills;
    AfterGather;
  end;
end;

procedure TrmBGBillsGatherData.BeforeGather;
begin
  FGatherData := TGatherData.Create;
  cdsBGBills.DisableControls;
  cdsBGBills.Active := True;
  cdsBGBills.EmptyDataSet;
end;

procedure TrmBGBillsGatherData.CalculateGatherData;
begin
  FGatherData.Calculate;
end;

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

procedure TrmBGBillsGatherData.GatherBGBills(ABGL: TBGLData;
  ABGLID: Integer);
var
  vBGBills: TBGBills;
begin
  with FProjectData.BGLData do
  begin
    cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGLID);
    cdsBGBills.Filtered := True;
    try
      cdsBGBills.First;
      while not cdsBGBills.Eof do
      begin
        vBGBills := ABGL.AddBGBills;
        vBGBills.B_Code := cdsBGBillsB_Code.AsString;
        vBGBills.Name := cdsBGBillsName.AsString;
        vBGBills.Units := cdsBGBillsUnits.AsString;
        vBGBills.Price := cdsBGBillsPrice.AsFloat;
        vBGBills.Quantity := cdsBGBillsQuantity.AsFloat;
        vBGBills.TotalPrice := cdsBGBillsTotalPrice.AsFloat;
        cdsBGBills.Next;
      end;
    finally
      cdsBGBills.Filtered := False;
    end;
  end;
end;

procedure TrmBGBillsGatherData.GatherBGL(ATenderData: TTenderData);
var
  vBGL: TBGLData;
begin
  with FProjectData.BGLData do
  begin
    cdsBGL.First;
    while not cdsBGL.Eof do
    begin
      vBGL := ATenderData.AddBGL(cdsBGLCode.AsString);
      GatherBGBills(vBGL, cdsBGLID.AsInteger);
      cdsBGL.Next;
    end;
  end;
end;

procedure TrmBGBillsGatherData.GatherMeasureData(ATenderData: TTenderData);

  procedure GatherCur(ANode: TMeasureBillsIDTreeNode);
  var
    sgsCode, sgsNum: TStrings;
    i: Integer;
    sCode: string;
    fNumber: Double;
    vBGL: TBGLData;
    vBGBills: TBGBills;
  begin
    sgsCode := TStringList.Create;
    sgsNum := TStringList.Create;
    try
      sgsCode.Delimiter := ';';
      sgsNum.Delimiter := ';';
      sgsCode.DelimitedText := ANode.StageRec.QcBGLCode.AsString;
      sgsNum.DelimitedText := ANode.StageRec.QcBGLNum.AsString;
      for i := 0 to sgsCode.Count - 1 do
      begin
        sCode := sgsCode[i];
        fNumber := StrToFloatDef(sgsNum[i], 0);
        vBGL := ATenderData.FindBGL(sCode);
        if Assigned(vBGL) then
        begin
          vBGBills := vBGL.FindBGBills(ANode.Rec.B_Code.AsString);
          if Assigned(vBGBills) then
            vBGBills.CurQuantity := vBGBills.CurQuantity + fNumber;
        end;
      end;
    finally
      sgsCode.Free;
      sgsNum.Free;
    end;
  end;

  procedure GatherPre(ANode: TMeasureBillsIDTreeNode);
  var
    sgsCode, sgsNum: TStrings;
    i: Integer;
    sCode: string;
    fNumber: Double;
    vBGL: TBGLData;
    vBGBills: TBGBills;
  begin
    sgsCode := TStringList.Create;
    sgsNum := TStringList.Create;
    try
      sgsCode.Delimiter := ';';
      sgsNum.Delimiter := ';';
      sgsCode.DelimitedText := ANode.StageRec.PreQcBGLCode.AsString;
      sgsNum.DelimitedText := ANode.StageRec.PreQcBGLNum.AsString;
      for i := 0 to sgsCode.Count - 1 do
      begin
        sCode := sgsCode[i];
        fNumber := StrToFloatDef(sgsNum[i], 0);
        vBGL := ATenderData.FindBGL(sCode);
        if Assigned(vBGL) then
        begin
          vBGBills := vBGL.FindBGBills(ANode.Rec.B_Code.AsString);
          if Assigned(vBGBills) then
            vBGBills.PreQuantity := vBGBills.PreQuantity + fNumber;
        end;
      end;
    finally
      sgsCode.Free;
      sgsNum.Free;
    end;
  end;

var
  i: Integer;
  vNode: TMeasureBillsIDTreeNode;
begin
  for i := 0 to FProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
  begin
    vNode := TMeasureBillsIDTreeNode(FProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
    if (vNode.HasChildren) or (not Assigned(vNode.StageRec)) then Continue;

    if (vNode.StageRec.QcBGLCode.AsString <> '') then
      GatherCur(vNode);
    if (vNode.StageRec.PreQcBGLCode.AsString <> '') then
      GatherPre(vNode);
  end;
end;

procedure TrmBGBillsGatherData.GatherProject(AProject: TSelectProject;
  AProjectIndex: Integer);
var
  vTenderData: TTenderData;
begin
  OpenProjectData(AProject, AProjectIndex);
  try
    vTenderData := FGatherData.AddTender(AProjectIndex, AProject.ProjectID, FProjectName);
    GatherBGL(vTenderData);
    GatherMeasureData(vTenderData);
  finally
    FreeProjectData;
  end;
end;

procedure TrmBGBillsGatherData.OpenProjectData(AProject: TSelectProject;
  AProjectIndex: Integer);
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.OpenForReport3(GetMyProjectsFilePath + Rec.ValueByName('FileName').AsString);
  end;
  FProjectName := Rec.ValueByName('Name').AsString;
end;

procedure TrmBGBillsGatherData.WriteData;

  procedure WriteBGLData(ATenderID: Integer; ABGL: TBGLData);
  var
    i: Integer;
    vBills: TBGBills;
  begin
    for i := 0 to ABGL.BGBillsCount - 1 do
    begin
      vBills := ABGL.BGBills[i];
      cdsBGBills.Append;
      cdsBGBillsTenderID.AsInteger := ATenderID;
      cdsBGBillsPartID.AsInteger := 2;
      cdsBGBillsIndexCode.AsString := vBills.IndexCode;
      cdsBGBillsB_Code.AsString := vBills.B_Code;
      cdsBGBillsName.AsString := vBills.Name;
      cdsBGBillsUnits.AsString := vBills.Units;
      cdsBGBillsPrice.AsFloat := vBills.Price;
      cdsBGBillsQuantity.AsFloat := vBills.Quantity;
      cdsBGBillsTotalPrice.AsFloat := vBills.TotalPrice;
      cdsBGBillsCurQuantity.AsFloat := vBills.CurQuantity;
      cdsBGBillsCurTotalPrice.AsFloat := vBills.CurTotalPrice;
      cdsBGBillsPreQuantity.AsFloat := vBills.PreQuantity;
      cdsBGBillsPreTotalPrice.AsFloat := vBills.PreTotalPrice;
      cdsBGBillsEndQuantity.AsFloat := vBills.EndQuantity;
      cdsBGBillsEndTotalPrice.AsFloat := vBills.EndTotalPrice;
      cdsBGBillsPercent.AsFloat := vBills.Percent;
      cdsBGBillsBGLCode.AsString := ABGL.BGLCode;
      cdsBGBills.Post;
    end;
  end;

  procedure WriteTenderData(ATender: TTenderData);
  var
    iBGL: Integer;
  begin
    cdsBGBills.Append;
    cdsBGBillsTenderID.AsInteger := ATender.SerialNo;
    cdsBGBillsPartID.AsInteger := 1;
    cdsBGBillsName.AsString := ATender.Name;
    cdsBGBills.Post;
    for iBGL := 0 to ATender.BGLCount - 1 do
      WriteBGLData(ATender.SerialNo, ATender.BGL[iBGL]);
    cdsBGBills.Append;
    cdsBGBillsTenderID.AsInteger := ATender.SerialNo;
    cdsBGBillsPartID.AsInteger := 3;
    cdsBGBillsName.AsString := 'С¼Æ';
    cdsBGBillsTotalPrice.AsFloat := ATender.TotalPrice;
    cdsBGBillsCurTotalPrice.AsFloat := ATender.CurTotalPrice;
    cdsBGBillsPreTotalPrice.AsFloat := ATender.PreTotalPrice;
    cdsBGBillsEndTotalPrice.AsFloat := ATender.EndTotalPrice;
    cdsBGBillsPercent.AsFloat := ATender.Percent;
    cdsBGBills.Post;
  end;

  procedure WriteGatherData;
  begin 
    cdsBGBills.Append;
    cdsBGBillsTenderID.AsInteger := FGatherData.TenderCount + 1;
    cdsBGBillsName.AsString := 'ºÏ¼Æ';
    cdsBGBillsTotalPrice.AsFloat := FGatherData.TotalPrice;
    cdsBGBillsCurTotalPrice.AsFloat := FGatherData.CurTotalPrice;
    cdsBGBillsPreTotalPrice.AsFloat := FGatherData.PreTotalPrice;
    cdsBGBillsEndTotalPrice.AsFloat := FGatherData.EndTotalPrice;
    cdsBGBillsPercent.AsFloat := FGatherData.Percent;
    cdsBGBills.Post;
  end;

var
  i: Integer;
begin
  for i := 0 to FGatherData.TenderCount - 1 do
    WriteTenderData(FGatherData.Tender[i]);
  WriteGatherData;
end;

{ TBGBills }

procedure TBGBills.Calcualte;
begin
  FCurTotalPrice := FCurQuantity * FPrice;
  FPreTotalPrice := FPreQuantity * FPrice;
  FEndQuantity := FCurQuantity + FPreQuantity;
  FEndTotalPrice := FEndQuantity * FPrice;
end;

function TBGBills.GetPercent: Double;
begin
  if FTotalPrice <> 0 then
    Result := CommonRoundTo(FEndTotalPrice / FTotalPrice * 100, -2)
  else
    Result := 0;
end;

procedure TBGBills.SetB_Code(const Value: string);
begin
  FB_Code := Value;
  FIndexCode := B_CodeToIndexCode(FB_Code);
end;

end.