Measure/DataModules/DetailGLDm.pas

unit DetailGLDm;

interface

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

type
  TDetailGLData = class(TDataModule)
    sdpDetailGL: TsdADOProvider;
    sddDetailGL: TsdDataSet;
    procedure sddDetailGLGetRecordClass(var ARecordClass: TsdRecordClass);
    procedure sddDetailGLBeforeDeleteRecord(ARecord: TsdDataRecord;
      var Allow: Boolean);
    procedure sddDetailGLBeforeValueChange(AValue: TsdValue;
      const NewValue: Variant; var Allow: Boolean);
  private
    FProjectData: TObject;

    procedure LoadRelaProjectGL;

    function FindDetailGL(ABillsID, AGLID: Integer): TDetailGLRecord;
    procedure ClearDetailGLs(ABillsID: Integer);
  public
    constructor Create(AProjectData: TObject);
    destructor Destroy; override;

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

    function AddDetailGL(ABillsID: Integer; AProjectGLRec: TProjectGLRecord;
      var sMessage: string): TDetailGLRecord;
    procedure AddDetailGLs(ABillsID: Integer; AGLs: TList);

    procedure LoadDetailGLs(ABillsID: Integer; AGLs: TList);
    function HasLockedDetailGL(ABillsID: Integer): Boolean;
    procedure ResetDetailGLs(ABillsID: Integer; AGLs: TList);

    procedure LoadProjectGL_DetailGLs(AGLID: Integer; AGLs: TList);

    function GetUnitPriceMargin(ABillsID: Integer): Double;

    property ProjectData: TObject read FProjectData write FProjectData;
  end;

implementation

uses
  Math, UtilMethods, ProjectData, ProjectProperty, ProjectGLDm,
  PriceMarginBillsDm, StageDm, PhasePayDm;

{$R *.dfm}

{ TDetailGLData }

function TDetailGLData.AddDetailGL(ABillsID: Integer;
  AProjectGLRec: TProjectGLRecord;
  var sMessage: string): TDetailGLRecord;
begin
  sMessage := '';
  Result := FindDetailGL(ABillsID, AProjectGLRec.ID.AsInteger);
  if not Assigned(Result) then
  begin
    Result := TDetailGLRecord(sddDetailGL.Add(True));
    Result.ID.AsInteger := GetsdDataSetNewID(sddDetailGL, 'idxID');
    Result.BillsID.AsInteger := ABillsID;
    Result.GLID.AsInteger := AProjectGLRec.ID.AsInteger;
    Result.Code.AsString := AProjectGLRec.Code.AsString;
    Result.CreatePhaseID.AsInteger := TProjectData(FProjectData).ProjProperties.PhaseCount;
    Result.RelaProjectGL := AProjectGLRec;
    Result.EndUpdate;
  end
  else
    sMessage := Format('编号：%s 名称：%s', [AProjectGLRec.Code.AsString, AProjectGLRec.Name.AsString]);
end;

procedure TDetailGLData.AddDetailGLs(ABillsID: Integer; AGLs: TList);
var
  i: Integer;
  sHint, sMessage: string;
begin
  for i := 0 to AGLs.Count - 1 do
  begin
    AddDetailGL(ABillsID, TProjectGLRecord(AGLs.Items[i]), sMessage);
    if sMessage <> '' then
    begin
      if sHint <> '' then
        sHint := sHint + #13#10;
      sHint := sHint + sMessage;
    end;
  end;
  if sMessage <> '' then
    TipMessage('以下工料已添加至该清单，请勿重复添加：' + #13#10 + sHint);
end;

procedure TDetailGLData.ResetDetailGLs(ABillsID: Integer; AGLs: TList);
var
  i, iNewID: Integer;
  Rec, GLRec: TDetailGLRecord;
begin
  if HasLockedDetailGL(ABillsID) then Exit;

  sddDetailGL.BeginUpdate;
  try
    ClearDetailGLs(ABillsID);
    iNewID := GetsdDataSetNewID(sddDetailGL, 'idxID');
    for i := 0 to AGLs.Count - 1 do
    begin
      GLRec := TDetailGLRecord(AGLs.Items[i]);
      Rec := TDetailGLRecord(sddDetailGL.Add);
      Rec.ID.AsInteger := iNewID + i;
      Rec.BillsID.AsInteger := ABillsID;
      Rec.GLID.AsInteger := GLRec.GLID.AsInteger;
      Rec.Code.AsInteger := GLRec.Code.AsInteger;
      Rec.Quantity.AsFloat := GLRec.Quantity.AsFloat;
      Rec.CreatePhaseID.AsInteger := TProjectData(FProjectData).ProjProperties.PhaseCount;
      
      Rec.RelaProjectGL := GLRec.RelaProjectGL;
    end;
  finally
    sddDetailGL.EndUpdate;
  end;
end;

procedure TDetailGLData.ClearDetailGLs(ABillsID: Integer);
var
  idx: TsdIndex;
  Rec: TsdDataRecord;
begin
  idx := sddDetailGL.FindIndex('idxBillsID');
  Rec := idx.FindKey(ABillsID);
  while Assigned(Rec) do
  begin
    sddDetailGL.Remove(Rec);
    Rec := idx.FindKey(ABillsID);
  end;
end;

procedure TDetailGLData.Close;
begin
  sddDetailGL.Close;
end;

constructor TDetailGLData.Create(AProjectData: TObject);
begin
  inherited Create(nil);
  FProjectData := AProjectData;
  sddDetailGL.AddIndex('idxView', 'BillsID;Code');
  sddDetailGL.AddIndex('idxFind', 'BillsID;GLID');
  sddDetailGL.AddIndex('idxBillsID', 'BillsID');
  sddDetailGL.AddIndex('idxID', 'ID');
  sddDetailGL.AddIndex('idxGLID', 'GLID');
end;

destructor TDetailGLData.Destroy;
begin

  inherited;
end;

function TDetailGLData.FindDetailGL(ABillsID,
  AGLID: Integer): TDetailGLRecord;
var
  idx: TsdIndex;
begin
  idx := sddDetailGL.FindIndex('idxFind');
  Result := TDetailGLRecord(idx.FindKey(VarArrayOf([ABillsID, AGLID])));
end;

procedure TDetailGLData.Open(AConnection: TADOConnection);
begin
  sdpDetailGL.Connection := AConnection;
  sddDetailGL.Open;
  // 建立与ProjectGL间的链接，以便计算时，快速获取工料的价格信息
  LoadRelaProjectGL;
end;

procedure TDetailGLData.Save;
begin
  SaveCacheData;
  sddDetailGL.Save;
end;

procedure TDetailGLData.LoadDetailGLs(ABillsID: Integer; AGLs: TList);
var
  idx: TsdIndex;
  iRec, iFirst, iLast: Integer;
begin
  idx := sddDetailGL.FindIndex('idxBillsID');
  iFirst := idx.FindKeyIndex(ABillsID);
  if iFirst <> -1 then
  begin
    iLast := idx.FindKeyLastIndex(ABillsID);
    for iRec := iFirst to iLast do
      AGLs.Add(idx.Records[iRec]);
  end;
end;

function TDetailGLData.GetUnitPriceMargin(ABillsID: Integer): Double;
var
  idx: TsdIndex;
  iRec, iFirst, iLast: Integer;
  Rec: TsdDataRecord;
begin
  Result := 0;
  idx := sddDetailGL.FindIndex('idxBillsID');
  iFirst := idx.FindKeyIndex(ABillsID);
  if iFirst <> -1 then
  begin
    iLast := idx.FindKeyLastIndex(ABillsID);
    for iRec := iFirst to iLast do
    begin
      Rec := idx.Records[iRec];
      with TProjectData(FProjectData).ProjectGLData do
        Result := Result + Rec.ValueByName('Quantity').AsFloat * ValidDeltaPrice[Rec.ValueByName('GLID').AsInteger];
    end;
  end;
end;

procedure TDetailGLData.LoadProjectGL_DetailGLs(AGLID: Integer;
  AGLs: TList);
var
  idx: TsdIndex;
  iRec, iFirst, iLast: Integer;
begin
  idx := sddDetailGL.FindIndex('idxGLID');
  iFirst := idx.FindKeyIndex(AGLID);
  if iFirst <> -1 then
  begin
    iLast := idx.FindKeyLastIndex(AGLID);
    for iRec := iFirst to iLast do
      AGLs.Add(idx.Records[iRec]);
  end;
end;

procedure TDetailGLData.sddDetailGLGetRecordClass(
  var ARecordClass: TsdRecordClass);
begin
  ARecordClass := TDetailGLRecord;
end;

procedure TDetailGLData.LoadRelaProjectGL;

  procedure LoadRela(AProjectGLRec: TProjectGLRecord);
  var
    vDetailGLs: TList;
    iGL: Integer;
    DetailGLRec: TDetailGLRecord;
  begin
    vDetailGLs := TList.Create;
    try
      LoadProjectGL_DetailGLs(AProjectGLRec.ID.AsInteger, vDetailGLs);
      for iGL := 0 to vDetailGLs.Count - 1 do
      begin
        DetailGLRec := TDetailGLRecord(vDetailGLs.Items[iGL]);
        DetailGLRec.RelaProjectGL := AProjectGLRec;
      end;
    finally
      vDetailGLs.Free;
    end;
  end;

var
  idx: TsdIndex;
  i: Integer;
  ProjectGLRec: TProjectGLRecord;
begin
  if not TProjectData(FProjectData).ProjectGLData.Active then Exit;
  
  idx := sddDetailGL.FindIndex('idxGLID');
  with TProjectData(FProjectData).ProjectGLData do
  begin
    for i := 0 to sddProjectGL.RecordCount - 1 do
    begin
      ProjectGLRec := TProjectGLRecord(sddProjectGL.Records[i]);
      LoadRela(ProjectGLRec);
    end;
  end;
end;

procedure TDetailGLData.SaveCacheData;

  function GetBillsQuantity(ABillsID: Integer): Double;
  var
    StageRec: TStageRecord;
  begin
    StageRec := TProjectData(FProjectData).PhaseData.StageData.StageRecord(ABillsID);
    if Assigned(StageRec) then
      Result := StageRec.GatherQuantity.AsFloat
    else
      Result := 0;
  end;

var
  idx: TsdIndex;
  DetailGL: TDetailGLRecord;
  fBillsQuantity: Double;
  iBillsID, iRec: Integer;
begin
  if TProjectData(FProjectData).PhaseData.StageDataReadOnly then Exit;

  idx := sddDetailGL.FindIndex('idxBillsID');
  iBillsID := -1;
  for iRec := 0 to idx.RecordCount - 1 do
  begin
    DetailGL := TDetailGLRecord(idx.Records[iRec]);
    if iBillsID <> DetailGL.BillsID.AsInteger then
    begin
      iBillsID := DetailGL.BillsID.AsInteger;
      fBillsQuantity := GetBillsQuantity(iBillsID);
    end;
    if DetailGL.LastBillsQuantity.AsFloat <> fBillsQuantity then
      DetailGL.LastBillsQuantity.AsFloat := fBillsQuantity;
  end;
end;

procedure TDetailGLData.sddDetailGLBeforeDeleteRecord(
  ARecord: TsdDataRecord; var Allow: Boolean);
begin
  Allow := TDetailGLRecord(ARecord).LockedPhaseID.AsInteger = 0;
  if not Allow then
    ErrorMessage('当前调差工料已被锁定，不可删除。');
end;

procedure TDetailGLData.sddDetailGLBeforeValueChange(AValue: TsdValue;
  const NewValue: Variant; var Allow: Boolean);
begin
  if SameText(AValue.FieldName, 'Quantity') then
  begin
    if TDetailGLRecord(AValue.Owner).LockedPhaseID.AsInteger > 0 then
      DataSetErrorMessage(Allow, '当前调差工料已被锁定，不可修改数量。');
  end;
end;

function TDetailGLData.HasLockedDetailGL(ABillsID: Integer): Boolean;
var
  idx: TsdIndex;
  iFirst, iLast, iRec: Integer;
  Rec: TDetailGLRecord;
begin
  Result := False;
  idx := sddDetailGL.FindIndex('idxBillsID');
  iFirst := idx.FindKeyIndex(ABillsID);
  if iFirst > -1 then
  begin
    iLast := idx.FindKeyLastIndex(ABillsID);
    for iRec := iFirst to iLast do
    begin
      Rec := TDetailGLRecord(idx.Records[iRec]);
      if Rec.LockedPhaseID > 0 then
      begin
        Result := True;
        Break;
      end;
    end;
  end;
end;

end.