Measure/TenderPartition/tpPartTenderSet.pas

unit tpPartTenderSet;

interface

uses
  Classes, tpPartTender, tpPeg, tpPricePartSettingFrm;

type
  TtpPartTenderSet = class
  private
    FPartTenders: TList;
    FPartPegs: TStringList;
    FPricePartInfo: TPricePartInfo;

    FSetFrame: TObject;

    function GetEndPricePart(ABegin: Double; APegs: TtpPegList): Double;
    procedure ExecutePricePart(APegs: TtpPegList);

    procedure ExecutePegPart(APegs: TtpPegList);

    function GetPartTender(AIndex: Integer): TtpPartTender;
    function GetTenderCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    procedure PegPart(APegs: TtpPegList);
    procedure PricePart(APegs: TtpPegList);

    property TenderCount: Integer read GetTenderCount;
    property PartTender[AIndex: Integer]: TtpPartTender read GetPartTender;
    property SetFrame: TObject read FSetFrame write FSetFrame;
  end;

implementation

uses
  ZhAPI, mPegFilter, tpPartTenderSetFme, Math, ProgressHintFrm,
  SysUtils, tpPegPartSettingFrm, Forms, Controls;

{ TtpPartTenderSet }

constructor TtpPartTenderSet.Create;
begin
  FPricePartInfo := TPricePartInfo.Create;
  FPartTenders := TList.Create;
  FPartPegs := TStringList.Create;
end;

destructor TtpPartTenderSet.Destroy;
begin
  FPartPegs.Free;
  ClearObjects(FPartTenders);
  FPartTenders.Free;
  FPricePartInfo.Free;
  inherited;
end;

procedure TtpPartTenderSet.ExecutePegPart(APegs: TtpPegList);
var
  i: Integer;
  vPartTender: TtpPartTender;
begin
  Screen.Cursor := crHourGlass;
  try
    ClearObjects(FPartTenders);
    for i := 0 to FPartPegs.Count - 1 do
    begin
      PegFilter.Filter(FPartPegs.Strings[i]);
      vPartTender := TtpPartTender.Create;
      FPartTenders.Add(vPartTender);
      vPartTender.FilterPegs(PegFilter, APegs);
    end;
    TtpPartTenderSetFrame(FSetFrame).RefreshData;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TtpPartTenderSet.ExecutePricePart(APegs: TtpPegList);
var
  iTender: Integer;
  fBegin, fEnd: Double;
  vPartTender: TtpPartTender;
begin
  Screen.Cursor := crHourGlass;
  ShowProgressHint('正在进行标段划分(金额模式)运算...');
  try
    ClearObjects(FPartTenders);

    fBegin := APegs.BeginPegNum;
    fEnd := fBegin;
    iTender := 1;
    while fEnd < APegs.EndPegNum do
    begin
      UpdateProgressHint(Format('正在划分第%d个标段...', [iTender]));
      fEnd := GetEndPricePart(fBegin, APegs);

      UpdateProgressHint(Format('正在确认第%d个标段数据...', [iTender]));
      vPartTender := TtpPartTender.Create;
      FPartTenders.Add(vPartTender);
      vPartTender.FilterPegs(fBegin, fEnd, APegs);
      fBegin := fEnd;
      Inc(iTender);
    end;
    TtpPartTenderSetFrame(FSetFrame).RefreshData;
  finally
    CloseProgressHint;
    Screen.Cursor := crDefault;
  end;
end;

function TtpPartTenderSet.GetEndPricePart(ABegin: Double;
  APegs: TtpPegList): Double;
var
  fEnd1, fTotalPrice1: Double;
  fTotalPrice: Double;
begin
  Result := ABegin + FPricePartInfo.MinLength * 1000;
  if Result < APegs.EndPegNum then
  begin
    fTotalPrice := APegs.TrialTotalPrice(ABegin, Result);
    while (fTotalPrice < FPricePartInfo.PartPrice) and (Result < APegs.EndPegNum) do
    begin
      Result := Min(APegs.EndPegNum, Result + FPricePartInfo.MinStep);
      fTotalPrice := APegs.TrialTotalPrice(ABegin, Result);
    end;

    if (APegs.EndPegNum - Result) > FPricePartInfo.MinStep then
    begin
      fEnd1 := Result - FPricePartInfo.MinStep;
      fTotalPrice1 := APegs.TrialTotalPrice(ABegin, fEnd1);
      if Abs(fTotalPrice1 - FPricePartInfo.PartPrice) < Abs(fTotalPrice - FPricePartInfo.PartPrice) then
        Result := fEnd1;
    end
    else
      Result := APegs.EndPegNum;
  end
  else
    Result := APegs.EndPegNum;
end;

function TtpPartTenderSet.GetPartTender(AIndex: Integer): TtpPartTender;
begin
  if AIndex < FPartTenders.Count then
    Result := TtpPartTender(FPartTenders.Items[AIndex])
  else
    Result := nil;
end;

function TtpPartTenderSet.GetTenderCount: Integer;
begin
  Result := FPartTenders.Count;
end;

procedure TtpPartTenderSet.PegPart(APegs: TtpPegList);
begin
  if FPartPegs.Count = 0 then
    FPartPegs.Add(APegs.BeginPeg+'~'+APegs.EndPeg);
  if PegPartSetting(FPartPegs) then
    ExecutePegPart(APegs);
end;

procedure TtpPartTenderSet.PricePart(APegs: TtpPegList);
begin
  if PricePartSetting(FPricePartInfo) then
    ExecutePricePart(APegs);
end;

end.