Measure/DataModules/ProjectGLDm.pas

unit ProjectGLDm;

interface

uses
  SysUtils, Classes, sdDB, sdProvider, ADODB, mDataRecord;

type
  TProjectGLData = class(TDataModule)
    sdpProjectGL: TsdADOProvider;
    sddProjectGL: TsdDataSet;
    sdvProjectGL: TsdDataView;
    procedure sddProjectGLAfterAddRecord(ARecord: TsdDataRecord);
    procedure sddProjectGLBeforeValueChange(AValue: TsdValue;
      const NewValue: Variant; var Allow: Boolean);
    procedure sddProjectGLAfterValueChanged(AValue: TsdValue);
    procedure sdvProjectGLGetText(var Text: String; ARecord: TsdDataRecord;
      AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean);
    procedure sddProjectGLGetRecordClass(var ARecordClass: TsdRecordClass);
    procedure sdvProjectGLSetText(var Text: String; ARecord: TsdDataRecord;
      AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean);
    procedure sddProjectGLBeforeDeleteRecord(ARecord: TsdDataRecord;
      var Allow: Boolean);
  private
    FProjectData: TObject;
    FTempGLs: TList;

    function CheckSameCode(ACode: Integer): Boolean;
    function CheckApplied(AGLID: Integer): Boolean;

    procedure LoadDetailGLs(AGLID: Integer);

    procedure CalculateDeltaPrice(ARec: TProjectGLRecord);
    procedure CalculatePrice;

    procedure CalculatePM_Quantity(ARec: TProjectGLRecord);
    procedure CalculatePM_TotalPrice(ARec: TProjectGLRecord);
    procedure CalculatePriceMargin;

    procedure CalculateRelaBills(ARec: TProjectGLRecord);

    procedure ExecuteSql(const ASql: string);
    procedure SaveGLPrice;
    procedure SavePM_CurData;

    procedure BeforeBatchOperation;
    procedure AfterBatchOperation;

    function GetValidDeltaPrice(AID: Integer): Double;
    function GetPM_TotalPrice: Double;
    function GetActive: Boolean;
  public
    constructor Create(AProjectData: TObject);
    destructor Destroy; override;

    procedure Open(AConnection: TADOConnection);
    procedure Save;

    procedure LoadCurPhaseInfoPrice;
    procedure LoadStagePM_CalcData;

    procedure CalculateAll;
    procedure CalculateGL_PM(AGLID: Integer);
    procedure CalculateGLs_PM(ADetailGLs: TList);

    property ProjectData: TObject read FProjectData write FProjectData;
    property Active: Boolean read GetActive;

    property ValidDeltaPrice[AID: Integer]: Double read GetValidDeltaPrice;
    property PM_TotalPrice: Double read GetPM_TotalPrice;
  end;

implementation

uses
  ProjectData, UtilMethods, DB, Variants, PhaseData, DetailGLDm,
  BillsMeasureDm, BillsTree, sdIDTree, PhasePayDm, DateUtils;

{$R *.dfm}

{ TProjectGLData }

function TProjectGLData.CheckSameCode(ACode: Integer): Boolean;
var
  Rec: TsdDataRecord;
begin
  Rec := sddProjectGL.FindKey('idxCode', ACode);
  Result := Assigned(Rec);
end;

constructor TProjectGLData.Create(AProjectData: TObject);
begin
  inherited Create(nil);
  FProjectData := AProjectData;
  FTempGLs := TList.Create;
end;

destructor TProjectGLData.Destroy;
begin
  FTempGLs.Free;
  inherited;
end;

procedure TProjectGLData.LoadCurPhaseInfoPrice;
const
  sSelectSql = 'Select * From GLPrice Where PhaseID = %d';
var
  sSql: string;
  vQuery: TADOQuery;

  procedure LoadInfoPrice;
  var
    iRec: Integer;
    Rec: TProjectGLRecord;
  begin
    for iRec := 0 to sddProjectGL.RecordCount - 1 do
    begin
      Rec := TProjectGLRecord(sddProjectGL.Records[iRec]);
      if vQuery.Active and vQuery.Locate('GLID', Rec.ValueByName('ID').AsInteger, []) then
      begin
        Rec.InfoPrice.AsFloat := vQuery.FieldByName('InfoPrice').AsFloat;
        Rec.InfoDate.AsString := vQuery.FieldByName('InfoDate').AsString;
        Rec.DeltaPrice.AsFloat := vQuery.FieldByName('DeltaPrice').AsFloat;
        Rec.ValidDeltaPrice.AsFloat := vQuery.FieldByName('ValidDeltaPrice').AsFloat;
      end
      else
      begin
        Rec.InfoPrice.AsFloat := 0;
        Rec.InfoDate.AsString := '';
        Rec.DeltaPrice.AsFloat := 0;
        Rec.ValidDeltaPrice.AsFloat := 0;
      end;
    end;
  end;

begin
  BeforeBatchOperation;
  vQuery := TADOQuery.Create(nil);
  try
    vQuery.Connection := sdpProjectGL.Connection;
    sSql := Format(sSelectSql, [TProjectData(FProjectData).PhaseIndex]);
    vQuery.SQL.Clear;
    vQuery.SQL.Add(sSql);
    vQuery.Open;
    LoadInfoPrice;
  finally
    vQuery.Free;
    AfterBatchOperation;
  end;
end;

procedure TProjectGLData.Open(AConnection: TADOConnection);
begin
  sdpProjectGL.Connection := AConnection;
  sddProjectGL.Open;
  if not Assigned(sddProjectGL.IndexList.FindByName('idxID')) then
    sddProjectGL.AddIndex('idxID', 'ID');
  if not Assigned(sddProjectGL.IndexList.FindByName('idxCode')) then
    sddProjectGL.AddIndex('idxCode', 'Code');
  sdvProjectGL.Open;
  sdvProjectGL.IndexName := 'idxCode';
  LoadCurPhaseInfoPrice;
  LoadStagePM_CalcData;
end;

procedure TProjectGLData.Save;
begin
  sddProjectGL.Save;
  if not TProjectData(FProjectData).PriceMarginReadOnly then
    SaveGLPrice;
  if not TProjectData(FProjectData).StageDataReadOnly then
    SavePM_CurData;
end;

procedure TProjectGLData.SaveGLPrice;
const
  sDeleteSql = 'Delete From GLPrice Where PhaseID = %d';
  sInsertSql = 'Insert Into GLPrice'+
               '  Select ID As GLID, %d As PhaseID, InfoPrice, InfoDate, DeltaPrice, ValidDeltaPrice' +
               '  From ProjectGL';
  sUpdateSql = 'Update GLPrice As G, ProjectGL As P'+
               '    Set G.PM_PreQuantity = P.PM_PreQuantity, G.PM_PreTotalPrice = P.PM_PreTotalPrice'+
               '  Where (G.PhaseID = %d) and (G.GLID = P.ID)';
var
  iPhaseID: Integer;
  sSql: String;
begin
  iPhaseID := TProjectData(FProjectData).ProjProperties.PhaseCount;
  sSql := Format(sDeleteSql, [iPhaseID]);
  ExecuteSql(sSql);

  sSql := Format(sInsertSql, [iPhaseID]);
  ExecuteSql(sSql);

  sSql := Format(sUpdateSql, [iPhaseID]);
  ExecuteSql(sSql);
end;

procedure TProjectGLData.sddProjectGLAfterAddRecord(
  ARecord: TsdDataRecord);
begin
  ARecord.ValueByName('ID').AsInteger := GetsdDataSetNewID(sddProjectGL, 'idxID');
  ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).ProjProperties.PhaseCount;
end;

procedure TProjectGLData.sddProjectGLBeforeValueChange(AValue: TsdValue;
  const NewValue: Variant; var Allow: Boolean);
var
  Rec: TProjectGLRecord;
begin
  Rec := TProjectGLRecord(AValue.Owner);
  if SameText(AValue.FieldName, 'Code') then
  begin
    if VarIsNull(NewValue) then
    begin
      DataSetErrorMessage(Allow, '编号不可为空。');
      if Rec.Code.AsString = '' then
        sddProjectGL.Remove(AValue.Owner);
    end
    else if CheckSameCode(NewValue) then
    begin
      DataSetErrorMessage(Allow, '编号不可重复。');
      if Rec.Code.AsString = '' then
        sddProjectGL.Remove(AValue.Owner);
    end
    else if CheckApplied(Rec.ID.AsInteger) then
      DataSetErrorMessage(Allow, '工料已被应用，不可修改编号。');
  end
  else if not(SameText(AValue.FieldName, 'ID') or
      SameText(AValue.FieldName, 'CreatePhaseID')) then
  begin
    if (Rec.Code.AsString = '') then
    begin
      DataSetErrorMessage(Allow, '编号不可为空，请先填写编号，再填写其他信息。');
      sddProjectGL.Remove(AValue.Owner);
    end;
  end;
end;

procedure TProjectGLData.sddProjectGLAfterValueChanged(AValue: TsdValue);
begin
  if SameText(AValue.FieldName, 'BasePrice') or
     SameText(AValue.FieldName, 'RiskRange') or
     SameText(AValue.FieldName, 'InfoPrice') then
  begin
    CalculateDeltaPrice(TProjectGLRecord(AValue.Owner));
    CalculatePM_Quantity(TProjectGLRecord(AValue.Owner));
    CalculatePM_TotalPrice(TProjectGLRecord(AValue.Owner));
    CalculateRelaBills(TProjectGLRecord(AValue.Owner));
    TProjectData(FProjectData).PriceMarginBillsData.RefreshAllDetailBills;
  end;
end;

procedure TProjectGLData.CalculateDeltaPrice(ARec: TProjectGLRecord);
var
  C0, Ci, r, DeltaC, RiskC, ValidDeltaC: Double;
begin
  C0 := ARec.BasePrice.AsFloat;
  Ci := ARec.InfoPrice.AsFloat;
  r := ARec.RiskRange.AsFloat;

  DeltaC := Ci - C0;
  RiskC := C0 * r / 100;
  if (DeltaC > 0) and (DeltaC - RiskC > 0) then
    ValidDeltaC := DeltaC - RiskC
  else if (DeltaC < 0) and (DeltaC + RiskC < 0) then
    ValidDeltaC := DeltaC + RiskC
  else
    ValidDeltaC := 0;

  if DeltaC <> ARec.DeltaPrice.AsFloat then
    ARec.DeltaPrice.AsFloat := PriceRoundTo(DeltaC);
  if ValidDeltaC <> ARec.ValidDeltaPrice.AsFloat then
    ARec.ValidDeltaPrice.AsFloat := PriceRoundTo(ValidDeltaC);
end;

procedure TProjectGLData.sdvProjectGLGetText(var Text: String;
  ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  DisplayText: Boolean);

  procedure GetDisplayText;
  begin
    if ((Pos('Price', AColumn.FieldName) > 0) or
        (Pos('Quantity', AColumn.FieldName) > 0) or
        SameText('RiskRange', AColumn.FieldName)) then
    begin
      if AValue.AsFloat = 0 then
        Text := '';
    end;
  end;

begin
  if DisplayText then
    GetDisplayText;
end;

procedure TProjectGLData.CalculateAll;
begin
  CalculatePrice;
  CalculatePriceMargin;
end;

procedure TProjectGLData.ExecuteSql(const ASql: string);
var
  vQuery: TADOQuery;
begin
  vQuery := TADOQuery.Create(nil);
  try
    vQuery.Connection := sdpProjectGL.Connection;
    vQuery.SQL.Add(ASql);
    vQuery.ExecSQL;
  finally
    vQuery.Free;
  end;
end;

function TProjectGLData.GetValidDeltaPrice(AID: Integer): Double;
var
  Rec: TProjectGLRecord;
begin
  Rec := TProjectGLRecord(sddProjectGL.FindKey('idxID', AID));
  if Assigned(Rec) then
    Result := Rec.ValidDeltaPrice.AsFloat
  else
    Result := 0;
end;

procedure TProjectGLData.CalculatePrice;
var
  iRec: Integer;
begin
  if TProjectData(FProjectData).PriceMarginReadOnly then Exit;

  for iRec := 0 to sddProjectGL.RecordCount - 1 do
    CalculateDeltaPrice(TProjectGLRecord(sddProjectGL.Records[iRec]));
end;

procedure TProjectGLData.CalculatePriceMargin;
var
  iRec: Integer;
  Rec: TProjectGLRecord;
begin
  if TProjectData(FProjectData).PhaseData.StageDataReadOnly then Exit;

  for iRec := 0 to sddProjectGL.RecordCount - 1 do
  begin
    Rec := TProjectGLRecord(sddProjectGL.Records[iRec]);
    CalculatePM_Quantity(Rec);
    CalculatePM_TotalPrice(Rec);
  end;
end;

procedure TProjectGLData.CalculatePM_Quantity(ARec: TProjectGLRecord);
var
  vGLs: TList;
  fQuantity: Double;
  i: Integer;
  GLRec: TsdDataRecord;
  BillsNode: TBillsIDTreeNode;
begin
  vGLs := TList.Create;
  try
    fQuantity := 0;
    with TProjectData(FProjectData).DetailGLData do
      LoadProjectGL_DetailGLs(ARec.ValueByName('ID').AsInteger, vGLs);

    for i := 0 to vGLs.Count - 1 do
    begin
      GLRec := TsdDataRecord(vGLs.Items[i]);
      with TProjectData(FProjectData).BillsMeasureData do
        BillsNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GLRec.ValueByName('BillsID').AsInteger));
      if Assigned(BillsNode.StageRec) then
        fQuantity := fQuantity + BillsNode.StageRec.GatherQuantity.AsFloat * GLRec.ValueByName('Quantity').AsFloat;
    end;

    if fQuantity <> ARec.PM_Quantity.AsFloat then
      ARec.PM_Quantity.AsFloat := fQuantity;
  finally
    vGLs.Free;
  end;
end;

procedure TProjectGLData.CalculatePM_TotalPrice(ARec: TProjectGLRecord);
var
  fTotalPrice: Double;
begin
  fTotalPrice := ARec.ValidDeltaPrice.AsFloat * ARec.PM_Quantity.AsFloat;
  if fTotalPrice <> ARec.PM_TotalPrice.AsFloat then
    ARec.PM_TotalPrice.AsFloat := fTotalPrice;
end;

procedure TProjectGLData.sddProjectGLGetRecordClass(
  var ARecordClass: TsdRecordClass);
begin
  ARecordClass := TProjectGLRecord;
end;

function TProjectGLData.GetPM_TotalPrice: Double;
var
  i: Integer;
  Rec: TProjectGLRecord;
begin
  Result := 0;
  for i := 0 to sddProjectGL.RecordCount - 1 do
  begin
    Rec := TProjectGLRecord(sddProjectGL.Records[i]);
    Result := Result + Rec.PM_TotalPrice.AsFloat;
  end;
end;

procedure TProjectGLData.SavePM_CurData;
const
  sUpdateSql = 'Update GLPrice As G, ProjectGL As P'+
               '  Set G.PM_Quantity%d = P.PM_Quantity, G.PM_TotalPrice%d = P.PM_TotalPrice,'+
               '    G.PM_Quantity_F = P.PM_Quantity, G.PM_TotalPrice_F = P.PM_TotalPrice'+
               '  Where (G.PhaseID = %d) and (G.GLID = P.ID)';
var
  iStageIndex: Integer;
  iPhaseCount: Integer;
  sSql: string;
begin
  iStageIndex := TProjectData(FProjectData).PhaseData.StageIndex;
  iPhaseCount := TProjectData(FProjectData).ProjProperties.PhaseCount;
  sSql := Format(sUpdateSql, [iStageIndex, iStageIndex, iPhaseCount]);
  ExecuteSql(sSql);
end;

procedure TProjectGLData.CalculateGL_PM(AGLID: Integer);
var
  Rec: TProjectGLRecord;
begin
  Rec := TProjectGLRecord(sddProjectGL.FindKey('idxID', AGLID));
  if not Assigned(Rec) then Exit;

  CalculatePM_Quantity(Rec);
  CalculatePM_TotalPrice(Rec);
end;

procedure TProjectGLData.CalculateGLs_PM(ADetailGLs: TList);
var
  i: Integer;
  DetailGLRec: TDetailGLRecord;
begin
  for i := 0 to ADetailGLs.Count - 1 do
  begin
    DetailGLRec := TDetailGLRecord(ADetailGLs.Items[i]);
    CalculateGL_PM(DetailGLRec.GLID.AsInteger);
  end;
end;

procedure TProjectGLData.CalculateRelaBills(ARec: TProjectGLRecord);
var
  iGL: Integer;
  DetailGLRec: TDetailGLRecord;
begin
  LoadDetailGLs(ARec.ID.AsInteger);
  for iGL := 0 to FTempGLs.Count - 1 do
  begin
    DetailGLRec := TDetailGLRecord(FTempGLs.Items[iGL]);
    with TProjectData(FProjectData).PhaseData do
      StageData.CalculatePriceMargin(DetailGLRec.BillsID.AsInteger);
  end;
  with TProjectData(FProjectData).PhaseData do
    StageData.CalculatePriceMarginNode;
end;

procedure TProjectGLData.LoadDetailGLs(AGLID: Integer);
begin
  FTempGLs.Clear;
  with TProjectData(FProjectData).DetailGLData do
    LoadProjectGL_DetailGLs(AGLID, FTempGLs);
end;

function TProjectGLData.GetActive: Boolean;
begin
  Result := sddProjectGL.Active;
end;

procedure TProjectGLData.sdvProjectGLSetText(var Text: String;
  ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  var Allow: Boolean);
var
  iPhaseID: Integer;
begin
  if SameText(AColumn.FieldName, 'Code') or
     SameText(AColumn.FieldName, 'Name') or
     SameText(AColumn.FieldName, 'Units') or
     SameText(AColumn.FieldName, 'Specs') or
     SameText(AColumn.FieldName, 'BasePrice') or
     SameText(AColumn.FieldName, 'RiskRange') then
  begin
    iPhaseID := TProjectGLRecord(ARecord).LockedPhaseID.AsInteger;
    if iPhaseID > 0 then
      DataSetErrorMessage(Allow, Format('该工料在第%d期已进行调差计算，不可修改基础数据。', [iPhaseID]));
  end;
end;

procedure TProjectGLData.LoadStagePM_CalcData;
const
  sSelectSql = 'Select GLID, PhaseID, PM_PreQuantity, PM_PreTotalPrice,'+
               '    PM_Quantity%d As PM_Quantity, PM_TotalPrice%d As PM_TotalPrice'+
               '  From GLPrice Where PhaseID = %d';
var
  sSql: string;
  vQuery: TADOQuery;

  procedure LoadPM_Calc;
  var
    iRec: Integer;
    Rec: TProjectGLRecord;
  begin
    for iRec := 0 to sddProjectGL.RecordCount - 1 do
    begin
      Rec := TProjectGLRecord(sddProjectGL.Records[iRec]);
      if vQuery.Active and vQuery.Locate('GLID', Rec.ValueByName('ID').AsInteger, []) then
      begin
        Rec.PM_Quantity.AsFloat := vQuery.FieldByName('PM_Quantity').AsFloat;
        Rec.PM_TotalPrice.AsFloat := vQuery.FieldByName('PM_TotalPrice').AsFloat;
      end
      else
      begin
        Rec.PM_Quantity.AsFloat := 0;
        Rec.PM_TotalPrice.AsFloat := 0;
      end;
    end;
  end;

begin
  BeforeBatchOperation;
  vQuery := TADOQuery.Create(nil);
  try
    vQuery.Connection := sdpProjectGL.Connection;
    with TProjectData(FProjectData) do
      sSql := Format(sSelectSql, [StageIndex, StageIndex, PhaseIndex]);
    vQuery.SQL.Clear;
    vQuery.SQL.Add(sSql);
    vQuery.Open;
    LoadPM_Calc;
  finally
    vQuery.Free;
    AfterBatchOperation;
  end;
end;

procedure TProjectGLData.AfterBatchOperation;
begin                         
  sddProjectGL.EndUpdate;
  sddProjectGL.EnableControls;
  sddProjectGL.BeforeValueChange := sddProjectGLBeforeValueChange;
  sddProjectGL.AfterValueChanged := sddProjectGLAfterValueChanged;
end;

procedure TProjectGLData.BeforeBatchOperation;
begin
  sddProjectGL.AfterValueChanged := nil;
  sddProjectGL.BeforeValueChange := nil;
  sddProjectGL.DisableControls;         
  sddProjectGL.BeginUpdate;
end;

function TProjectGLData.CheckApplied(AGLID: Integer): Boolean;
begin
  LoadDetailGLs(AGLID);
  Result := FTempGLs.Count > 0;
end;

procedure TProjectGLData.sddProjectGLBeforeDeleteRecord(
  ARecord: TsdDataRecord; var Allow: Boolean);
begin
  Allow := not CheckApplied(ARecord.ValueByName('ID').AsInteger);
  if not Allow then
    ErrorMessage('工料已被应用，不可删除。');
end;

end.