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);
    procedure sddDetailGLAfterDeleteRecord(ARecord: TsdDataRecord);
  private
    FProjectData: TObject;

    procedure LoadRelaProjectGL;

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

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

    function AddLeafXmjGl(ARec: TDetailGLRecord): TsdDataRecord;
    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 ClearDetailGLs(ABillsID: Integer);
    procedure ResetDetailGLs(ABillsID: Integer; AGLs: TList);

    procedure LoadXmjDetailGLs(AXmjID, AGLID: Integer; AGLs: TList);

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

    function HasXmjDetailGL(AXmjID, AGLID: Integer): Boolean;

    function GetUnitPriceMargin(ABillsID: Integer): Double;

    property ProjectData: TObject read FProjectData write FProjectData;
  end;

implementation

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

{$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]);

  AddLeafXmjGl(Result);
end;

procedure TDetailGLData.AddDetailGLs(ABillsID: Integer; AGLs: TList);
var
  i: Integer;
  sHint, sMessage: string;
begin
  sHint := '';
  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 sHint <> '' 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;

  ClearDetailGLs(ABillsID);

  sddDetailGL.BeginUpdate;
  try
    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;

      AddLeafXmjGl(Rec);
    end;
  finally
    sddDetailGL.EndUpdate;
  end;
end;

procedure TDetailGLData.ClearDetailGLs(ABillsID: Integer);
var
  idx: TsdIndex;
  iFirst, iLast, iRec, iLeafXmjID, iGLID: Integer;
  Rec: TDetailGLRecord;
begin
  sddDetailGL.BeginUpdate;
  try
    iLeafXmjID := TProjectData(FProjectData).BillsCompileData.GetLeafXmjParentID(ABillsID);
    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]);
        iGLID := Rec.GLID.AsInteger;
        sddDetailGL.Remove(Rec);
        if not HasXmjDetailGL(iLeafXmjID, iGLID) then
          TProjectData(FProjectData).LeafXmjGlData.DeleteLeafXmjGl(iLeafXmjID, iGLID);
      end;
    end;
  finally
    sddDetailGL.EndUpdate;
  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;
  ProjGLRec: 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
      ProjGLRec := TProjectGLRecord(sddProjectGL.Records[i]);
      LoadRela(ProjGLRec);
    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.AsInteger > 0 then
      begin
        Result := True;
        Break;
      end;
    end;
  end;
end;

function TDetailGLData.AddLeafXmjGl(ARec: TDetailGLRecord): TsdDataRecord;
var
  iLeafXmjID: Integer;
begin
  // 对应最底层项目节应新增
  with TProjectData(FProjectData) do
  begin
    iLeafXmjID := BillsCompileData.GetLeafXmjParentID(ARec.BillsID.AsInteger);
    LeafXmjGlData.AddLeafXmjGl(iLeafXmjID, ARec.GLID.AsInteger);
  end;
end;

procedure TDetailGLData.sddDetailGLAfterDeleteRecord(
  ARecord: TsdDataRecord);
var
  iLeafXmjID: Integer;
begin
  with TProjectData(FProjectData) do
  begin
    iLeafXmjID := BillsCompileData.GetLeafXmjParentID(TDetailGLRecord(ARecord).BillsID.AsInteger);
    if not HasXmjDetailGL(iLeafXmjID, TDetailGLRecord(ARecord).GLID.AsInteger) then
      LeafXmjGlData.DeleteLeafXmjGl(iLeafXmjID, TDetailGLRecord(ARecord).GLID.AsInteger);
  end;
end;

procedure TDetailGLData.LoadXmjDetailGLs(AXmjID, AGLID: Integer; AGLs: TList);
var
  vLeafBills: TList;
  i: Integer;
  Rec: TsdDataRecord;
begin
  vLeafBills := TList.Create;
  try
    TProjectData(FProjectData).BillsCompileData.LoadLeafBillsID(AXmjID, vLeafBills);
    for i := 0 to vLeafBills.Count - 1 do
    begin
      Rec := sddDetailGL.FindKey('idxFind', VarArrayOf([Integer(vLeafBills.Items[i]), AGLID]));
      if Assigned(Rec) then
        AGLs.Add(Rec);
    end;
  finally
    vLeafBills.Free;
  end;
end;

function TDetailGLData.HasXmjDetailGL(AXmjID, AGLID: Integer): Boolean;
var
  vXmj, vChild: TsdIDTreeNode;
  iChild: Integer;
begin
  Result := False;
  vXmj := TProjectData(FProjectData).BillsCompileData.BillsCompileTree.FindNode(AXmjID);
  if vXmj.HasChildren then
  begin
    for iChild := 0 to vXmj.ChildCount - 1 do
    begin
      vChild := vXmj.ChildNodes[iChild];
      if HasXmjDetailGL(vChild.ID, AGLID) then
      begin
        Result := True;
        Break;
      end;
    end;
  end
  else
    Result := Assigned(sddDetailGL.FindKey('idxFind', VarArrayOf([AXmjID, AGLID])));
end;

end.