Measure/DataModules/BGLDm.pas

unit BGLDm;

interface

uses
  SysUtils, Classes, DB, DBClient, Provider, ADODB, sdIDTree,
  sdDB;

type
  TAfterCurrentBGLChanged = procedure of object;

  TBGLSelectInfo = class(TObject)
  private
    FB_Code: string;
    FName: string;
    FUnits: string;
    FPrice: Double;

    FIsOrg: Boolean;
    FTotalNum: Double;
    FNums: TStrings;
    FCodes: TStrings;
    procedure SetMergedCode(const Value: string);
    procedure SetMergedNum(const Value: string);
    function GetCount: Integer;
    function GetMergedCode: string;
    function GetMergedNum: string;
  public
    constructor Create(ARec: TsdDataRecord; ATotalNum: Double; AIsOrg: Boolean);
    destructor Destroy; override;
    procedure Clear;

    property MergedCode: string read GetMergedCode write SetMergedCode;
    property MergedNum: string read GetMergedNum write SetMergedNum;
    property Codes: TStrings read FCodes;
    property Nums: TStrings read FNums;
    property Count: Integer read GetCount;
    property TotalNum: Double read FTotalNum write FTotalNum;
    property IsOrg: Boolean read FIsOrg;

    property B_Code: string read FB_Code;
    property Name: string read FName;
    property Units: string read FUnits;
    property Price: Double read FPrice;
  end;

  TBGLData = class(TDataModule)
    atBGL: TADOTable;
    dspBGL: TDataSetProvider;
    cdsBGL: TClientDataSet;
    cdsBGLID: TIntegerField;
    cdsBGLCode: TWideStringField;
    cdsBGLName: TWideStringField;
    cdsBGLTotalPrice: TFloatField;
    cdsBGLPos_Reason: TMemoField;
    cdsBGLDirection: TMemoField;
    cdsBGLDrawingCode: TWideStringField;
    cdsBGLApprovalCode: TWideStringField;
    cdsBGLCreatePhaseID: TIntegerField;
    cdsBGLExecutionRate: TFloatField; 
    cdsBGLBGLType: TWideStringField;

    cdsBGLView: TClientDataSet;
    cdsBGLViewID: TIntegerField;
    cdsBGLViewCode: TWideStringField;
    cdsBGLViewName: TWideStringField;
    cdsBGLViewTotalPrice: TFloatField;
    cdsBGLViewPos_Reason: TMemoField;
    cdsBGLViewDirection: TMemoField;
    cdsBGLViewDrawingCode: TWideStringField;
    cdsBGLViewApprovalCode: TWideStringField;
    cdsBGLViewCreatePhaseID: TIntegerField;
    cdsBGLViewExecutionRate: TFloatField;
    cdsBGLViewBGLType: TWideStringField;

    dsBGL: TDataSource;

    atBGBills: TADOTable;
    dspBGBills: TDataSetProvider;
    cdsBGBills: TClientDataSet;
    cdsBGBillsID: TIntegerField;
    cdsBGBillsBGID: TIntegerField;
    cdsBGBillsB_Code: TWideStringField;
    cdsBGBillsName: TWideStringField;
    cdsBGBillsUnits: TWideStringField;
    cdsBGBillsPrice: TFloatField;
    cdsBGBillsQuantity: TFloatField;
    cdsBGBillsTotalPrice: TFloatField;
    cdsBGBillsUsedQuantity: TFloatField;
    
    cdsBGBillsView: TClientDataSet;
    cdsBGBillsViewID: TIntegerField;
    cdsBGBillsViewBGID: TIntegerField;
    cdsBGBillsViewB_Code: TWideStringField;
    cdsBGBillsViewName: TWideStringField;
    cdsBGBillsViewUnits: TWideStringField;
    cdsBGBillsViewPrice: TFloatField;
    cdsBGBillsViewQuantity: TFloatField;
    cdsBGBillsViewTotalPrice: TFloatField;
    cdsBGBillsViewUsedQuantity: TFloatField;
    cdsBGLIsCloud: TBooleanField;
    cdsBGLWebID: TIntegerField;
    cdsBGLViewIsCloud: TBooleanField;
    cdsBGLViewWebID: TIntegerField;
    procedure cdsBGBillsViewAfterInsert(DataSet: TDataSet);
    procedure cdsBGBillsViewAfterPost(DataSet: TDataSet);
    procedure cdsBGBillsViewQuantityChange(Sender: TField);
    procedure cdsBGBillsViewBeforePost(DataSet: TDataSet);
    procedure cdsBGLViewBeforePost(DataSet: TDataSet);
    procedure cdsBGLViewBeforeDelete(DataSet: TDataSet);
    procedure cdsBGBillsViewBeforeDelete(DataSet: TDataSet);
    procedure cdsBGBillsViewAfterDelete(DataSet: TDataSet);
    procedure cdsBGLViewNewRecord(DataSet: TDataSet);
    procedure cdsBGBillsViewQuantitySetText(Sender: TField;
      const Text: String);
    procedure cdsBGBillsViewPriceSetText(Sender: TField;
      const Text: String);
    procedure cdsBGLViewCodeChange(Sender: TField);
    procedure cdsBGLViewAfterScroll(DataSet: TDataSet);
  private
    FProjectData: TObject;
    FAfterCurrentBGLChanged: TAfterCurrentBGLChanged;

    procedure GatherBGLTotalPrice(ABGLID: Integer);
    procedure UpdateBGLTotalPrice(ABGLID: Integer; ADiffer: Double);

    procedure UpdateBGLExecutionRate(ABGLID: Integer);
    procedure ApplyBGL(ABGLInfo: TBGLSelectInfo); overload;

    function DeleteWeb(AWebID: Integer): Boolean;
    procedure DeleteBGBills(ABGID: Integer);

    function CheckSameB_Code(ABGID: Integer; const AB_Code: string): Boolean;
    function CheckBGLUsed(ABGID: Integer): Boolean;

    function LocateBGL(const ACode: string): Boolean;
    function LocateBGBills(ABGID: Integer; const AB_Code, AName, AUnit: string; APrice: Double): Boolean;
    function GetTotalPrice: Double;
    function GetEndTotalPrice(AEndPhase: Integer): Double;
  public
    constructor Create(AProjectData: TObject);
    destructor Destroy; override;

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

    function GetBGLCanEdit(ASerialNo: Integer): Boolean;

    function AllBGLTotalPrice: Double;

    function AllCloudBGLWebID: string;
    procedure LoadCloudBGL(const ABGLs: string);

    procedure AddBGL(const sCode: string);
    procedure ApplyBGL(AOrgBGL, ANewBGL: TBGLSelectInfo); overload;

    procedure BatchWritePos_Reason;

    property ProjectData: TObject read FProjectData;
    property TotalPrice: Double read GetTotalPrice;
    property EndTotalPrice[AEndPhase: Integer]: Double read GetEndTotalPrice;
    property AfterCurrentBGLChanged: TAfterCurrentBGLChanged read FAfterCurrentBGLChanged write FAfterCurrentBGLChanged;
  end;

implementation

uses
  ZhAPI, Math, ProjectData, BillsDm, Variants, UtilMethods, superobject,
  PHPWebDm, Forms, Controls;

{$R *.dfm}

{ TBGLSelectInfo }

procedure TBGLSelectInfo.Clear;
begin
  FCodes.Clear;
  FNums.Clear;
end;

constructor TBGLSelectInfo.Create(ARec: TsdDataRecord;
  ATotalNum: Double; AIsOrg: Boolean);
begin
  FB_Code := ARec.ValueByName('B_Code').AsString;
  FName := ARec.ValueByName('Name').AsString;
  FUnits := ARec.ValueByName('Units').AsString;
  FPrice := ARec.ValueByName('Price').AsFloat;

  FTotalNum := ATotalNum;
  FIsOrg := AIsOrg;

  FCodes := TStringList.Create;
  FCodes.Delimiter := ';';
  FNums := TStringList.Create;
  FNums.Delimiter := ';';
end;

destructor TBGLSelectInfo.Destroy;
begin
  FNums.Free;
  FCodes.Free;
  inherited;
end;

function TBGLSelectInfo.GetCount: Integer;
begin
  Result := Min(FCodes.Count, FNums.Count);
end;

function TBGLSelectInfo.GetMergedCode: string;
begin
  Result := FCodes.DelimitedText;
end;

function TBGLSelectInfo.GetMergedNum: string;
begin
  Result := FNums.DelimitedText;
end;

procedure TBGLSelectInfo.SetMergedCode(const Value: string);
begin
  if Value <> '' then
    FCodes.DelimitedText := Value
  else
    FCodes.Clear;
end;

procedure TBGLSelectInfo.SetMergedNum(const Value: string);
begin
  if Value <> '' then
    FNums.DelimitedText := Value
  else
    FNums.Clear;
end;

{ TBGLData }

constructor TBGLData.Create(AProjectData: TObject);
begin
  inherited Create(nil);
  FProjectData := AProjectData;
end;

destructor TBGLData.Destroy;
begin
  inherited;
end;

procedure TBGLData.Open(AConnection: TADOConnection);
begin
  atBGL.Connection := AConnection;
  cdsBGL.Open;
  cdsBGL.AddIndex('idxID', 'ID', []);
  cdsBGL.AddIndex('idxCode', 'Code', []);
  cdsBGL.IndexName := 'idxID';
  cdsBGLView.CloneCursor(cdsBGL, True);

  atBGBills.Connection := AConnection;
  cdsBGBills.Open;
  cdsBGBillsView.CloneCursor(cdsBGBills, True);
  cdsBGBills.IndexFieldNames := 'ID';
  cdsBGBillsView.MasterSource := dsBGL;
  cdsBGBillsView.MasterFields := 'ID';
  cdsBGBillsView.IndexFieldNames := 'BGID;ID';
end;

procedure TBGLData.Save;
begin
  cdsBGL.ApplyUpdates(0);
  cdsBGBills.ApplyUpdates(0);
end;

procedure TBGLData.cdsBGBillsViewAfterInsert(DataSet: TDataSet);
begin
  cdsBGBillsViewID.AsInteger := GetNewIDOfIndex(cdsBGBills);
  cdsBGBillsViewBGID.AsInteger := cdsBGLViewID.AsInteger;
end;

procedure TBGLData.AddBGL(const sCode: string);
begin
  cdsBGLView.DisableControls;
  cdsBGLView.Append;
  cdsBGLViewCode.AsString := sCode;
  cdsBGLView.Post;
  cdsBGLView.EnableControls;
end;

procedure TBGLData.cdsBGBillsViewAfterPost(DataSet: TDataSet);

  procedure DoB_CodeChange;
  var
    Rec: TsdDataRecord;
  begin
    cdsBGBillsViewB_Code.Tag := 0;
    cdsBGBillsView.Edit;
    with TProjectData(FProjectData).BillsData do
    begin
      Rec := sddBills.Locate('B_Code', cdsBGBillsViewB_Code.AsString);
      if Rec <> nil then
      begin
        cdsBGBillsViewName.AsString := Rec.ValueByName('Name').AsString;
        cdsBGBillsViewUnits.AsString := Rec.ValueByName('Units').AsString;
        cdsBGBillsViewPrice.AsString := Rec.ValueByName('Price').AsString;
      end;
    end;
    cdsBGBillsView.Post;
  end;

  procedure ClearChangeTag;
  begin
    cdsBGBillsViewB_Code.Tag := 0;
    cdsBGBillsViewName.Tag := 0;
    cdsBGBillsViewUnits.Tag := 0;
    cdsBGBillsViewPrice.Tag := 0;
    cdsBGBillsViewQuantity.Tag := 0;
  end;

var
  fTotalPrice, Differ: Double;
begin
  if (cdsBGBillsViewB_Code.Tag = 1) then
    DoB_CodeChange;

  if (cdsBGBillsViewPrice.Tag = 1) or
      (cdsBGBillsViewQuantity.Tag = 1) then
  begin
    cdsBGBillsViewPrice.Tag := 0;
    cdsBGBillsViewQuantity.Tag := 0;
    fTotalPrice := TotalPriceRoundTo(cdsBGBillsViewPrice.AsFloat * cdsBGBillsViewQuantity.AsFloat);
    UpdateBGLTotalPrice(cdsBGBillsViewBGID.AsInteger, fTotalPrice - cdsBGBillsViewTotalPrice.AsFloat);
    UpdateBGLExecutionRate(cdsBGBillsViewBGID.AsInteger);
    cdsBGBillsView.Edit;
    cdsBGBillsViewTotalPrice.AsFloat := fTotalPrice;
    cdsBGBillsView.Post;
  end;

  ClearChangeTag;
end;

procedure TBGLData.cdsBGBillsViewQuantityChange(Sender: TField);
begin
  Sender.Tag := 1;
end;

procedure TBGLData.GatherBGLTotalPrice(ABGLID: Integer);
var
  fGather: Double;
begin
  cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGLID);
  cdsBGBills.Filtered := True;
  try
    fGather := 0;
    cdsBGBills.First;
    while not cdsBGBills.Eof do
    begin
      fGather := fGather + cdsBGBillsTotalPrice.AsFloat;
      cdsBGBills.Next;
    end;
    if cdsBGL.FindKey([ABGLID]) then
    begin
      cdsBGL.Edit;
      cdsBGLTotalPrice.AsFloat := fGather;
      cdsBGL.Post;
    end;
  finally
    cdsBGBills.Filtered := False;
  end;
end;

procedure TBGLData.UpdateBGLTotalPrice(ABGLID: Integer; ADiffer: Double);
begin
  if cdsBGL.FindKey([ABGLID]) then
  begin
    cdsBGL.Edit;
    cdsBGLTotalPrice.AsFloat := cdsBGLTotalPrice.AsFloat + ADiffer;
    cdsBGL.Post;
  end;
end;

procedure TBGLData.ApplyBGL(AOrgBGL, ANewBGL: TBGLSelectInfo);
begin
  ApplyBGL(AOrgBGL);
  ApplyBGL(ANewBGL);
end;

procedure TBGLData.ApplyBGL(ABGLInfo: TBGLSelectInfo);
var
  I: Integer;
  fNum: Double;
begin
  for I := 0 to ABGLInfo.Count - 1 do
    if LocateBGL(ABGLInfo.Codes[I]) and
        LocateBGBills(cdsBGLID.AsInteger, ABGLInfo.B_Code, ABGLInfo.Name, ABGLInfo.Units, ABGLInfo.Price) then
    begin
      cdsBGBills.Edit;
      fNum := QuantityRoundTo(StrToFloatDef(ABGLInfo.Nums[I], 0));
      if ABGLInfo.IsOrg then
        cdsBGBillsUsedQuantity.AsFloat := QuantityRoundTo(cdsBGBillsUsedQuantity.AsFloat - fNum)
      else
        cdsBGBillsUsedQuantity.AsFloat := QuantityRoundTo(cdsBGBillsUsedQuantity.AsFloat + fNum);
      cdsBGBills.Post;
      UpdateBGLExecutionRate(cdsBGBillsBGID.AsInteger);
    end;
end;

procedure TBGLData.cdsBGBillsViewBeforePost(DataSet: TDataSet);

  procedure DisplayErrorMessage(const AHint: string);
  begin
    cdsBGBillsViewB_Code.Tag := 0;
    cdsBGBillsViewName.Tag := 0;
    cdsBGBillsViewUnits.Tag := 0;
    cdsBGBillsViewPrice.Tag := 0;
    cdsBGBillsViewQuantity.Tag := 0;
    ErrorMessage(AHint);
    Abort;
  end;

begin
  if (cdsBGBillsViewB_Code.Tag = 1) or
      (cdsBGBillsViewName.Tag = 1) or
      (cdsBGBillsViewUnits.Tag = 1) or
      (cdsBGBillsViewPrice.Tag = 1) then
  begin
    if cdsBGBillsViewUsedQuantity.AsFloat <> 0 then
      DisplayErrorMessage('变更令已被应用至清单，不可修改！');
  end;

  if (cdsBGBillsViewQuantity.Tag = 1) then
  begin
    if (cdsBGBillsViewUsedQuantity.AsFloat <> 0) and
       (cdsBGBillsViewQuantity.AsFloat < cdsBGBillsViewUsedQuantity.AsFloat) then
      DisplayErrorMessage('变更清单的清单数量应大于已变更数量！');
  end;

  if cdsBGBillsViewB_Code.Tag = 1 then
    if CheckSameB_Code(cdsBGBillsViewBGID.AsInteger, cdsBGBillsViewB_Code.AsString) then
    begin
      DisplayErrorMessage('不允许存在同编号变更清单！');
    end;
end;

procedure TBGLData.cdsBGLViewBeforePost(DataSet: TDataSet);
var
  iIncrement: Integer;
  sNewCode: string;
begin
  if cdsBGLViewIsCloud.AsBoolean then
  begin
    cdsBGLViewCode.Tag := 0;
    WarningMessage('当前变更令不允许编辑。');
    DataSet.Cancel;
    Abort;
  end;

  // 变更令号不可为空
  if cdsBGLViewCode.AsString = '' then
  begin
    cdsBGLViewCode.Tag := 0;
    if cdsBGL.FindKey([cdsBGLViewID.AsInteger]) then
      if cdsBGLCode.AsString <> '' then
        WarningMessage('变更令号不允许为空，如需删除，请点击右键进行删除。');
    DataSet.Cancel;
    Abort;
  end;

  if cdsBGLViewCode.Tag = 1 then
  begin
    cdsBGLViewCode.Tag := 0;

    if CheckBGLUsed(cdsBGLViewID.AsInteger) then
    begin
      ErrorMessage('当前变更令下变更清单已被应用到清单，不可修改！');
      Abort;
    end;

    sNewCode := cdsBGLViewCode.AsString;
    if Pos(';', sNewCode) > 0 then
    begin
      ErrorMessage('变更令号不可输入'';''，请使用其他符号代替！');
      Abort;
    end;

    // 相同变更令号应递增[1],[2]...
    iIncrement := 1;
    while LocateBGL(sNewCode) and (cdsBGLID.AsInteger <> cdsBGLViewID.AsInteger) do
    begin
      sNewCode := Format('%s[%d]', [cdsBGLViewCode.AsString, iIncrement]);
      Inc(iIncrement);
    end;
    if cdsBGLViewCode.AsString <> sNewCode then
    begin
      cdsBGLViewCode.AsString := sNewCode;
      cdsBGLViewCode.Tag := 0;
    end;
  end;
end;

procedure TBGLData.DeleteBGBills(ABGID: Integer);
begin
  cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGID);
  cdsBGBills.Filtered := True;
  try
    cdsBGBills.First;
    while not cdsBGBills.Eof do
      cdsBGBills.Delete;
  finally
    cdsBGBills.Filtered := False;
  end;
end;

procedure TBGLData.cdsBGLViewBeforeDelete(DataSet: TDataSet);
begin
  if CheckBGLUsed(cdsBGLViewID.AsInteger) then
    raise Exception.Create('变更令下变更清单已被应用到清单，不可删除！');
  //if cdsBGLViewIsCloud.AsBoolean then
    //raise Exception.Create('云端获取的变更令不允许删除！');
  if cdsBGLViewIsCloud.AsBoolean and not DeleteWeb(cdsBGLViewWebID.AsInteger) then
    raise Exception.Create('同步删除云端数据失败，请重试');
  DeleteBGBills(cdsBGLViewID.AsInteger);
end;

function TBGLData.CheckSameB_Code(ABGID: Integer;
  const AB_Code: string): Boolean;
begin
  Result := False;
  cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGID);
  cdsBGBills.Filtered := True;
  try
    cdsBGBills.First;
    while (not cdsBGBills.Eof) and (not Result) do
    begin
      Result := Result or SameText(cdsBGBillsB_Code.AsString, AB_Code);
      cdsBGBills.Next;
    end;
  finally
    cdsBGBills.Filtered := False;
  end;
end;

procedure TBGLData.cdsBGBillsViewBeforeDelete(DataSet: TDataSet);
begin
  if cdsBGBillsViewUsedQuantity.AsFloat <> 0 then
    raise Exception.Create('变更清单已被应用至清单，不可删除！');
  if cdsBGLViewIsCloud.AsBoolean then
    raise Exception.Create('云端获取的变更清单不允许删除！');
end;

function TBGLData.CheckBGLUsed(ABGID: Integer): Boolean;
begin
  Result := False;
  cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGID);
  cdsBGBills.Filtered := True;
  try
    cdsBGBills.First;
    while (not cdsBGBills.Eof) and (not Result) do
    begin
      Result := Result or (cdsBGBillsUsedQuantity.AsFloat <> 0);
      cdsBGBills.Next;
    end;
  finally
    cdsBGBills.Filtered := False;
  end;
end;

procedure TBGLData.cdsBGBillsViewAfterDelete(DataSet: TDataSet);
begin
  GatherBGLTotalPrice(cdsBGLViewID.AsInteger);
  UpdateBGLExecutionRate(cdsBGLViewID.AsInteger);
end;

procedure TBGLData.BatchWritePos_Reason;
begin
  cdsBGL.First;
  while not cdsBGL.Eof do
  begin
    cdsBGL.Edit;
    cdsBGLPos_Reason.AsString := cdsBGLName.AsString;
    cdsBGL.Post;
    cdsBGL.Next;
  end;
end;

procedure TBGLData.cdsBGLViewNewRecord(DataSet: TDataSet);
begin
  cdsBGLViewID.AsInteger := GetNewIDOfIndex(cdsBGL);
  cdsBGLViewCreatePhaseID.AsInteger := TProjectData(FProjectData).PhaseIndex;
end;

procedure TBGLData.UpdateBGLExecutionRate(ABGLID: Integer);

  function GetBGLExecutionTotalPrice: Double;
  var
    cdsTemp: TClientDataSet;
  begin
    Result := 0;
    cdsTemp := TClientDataSet.Create(nil);
    try
      cdsTemp.CloneCursor(cdsBGBills, True);
      cdsTemp.Filter := Format('BGID = %d', [ABGLID]);
      cdsTemp.Filtered := True;
      cdsTemp.First;
      while not cdsTemp.Eof do
      begin
        Result := Result + TotalPriceRoundTo(
            cdsTemp.FieldByName('UsedQuantity').AsFloat * cdsTemp.FieldByName('Price').AsFloat);
        cdsTemp.Next;
      end;
    finally
      cdsTemp.Free;
    end;
  end;

begin
  if cdsBGL.FindKey([ABGLID]) then
  begin
    cdsBGL.Edit;
    if cdsBGLTotalPrice.AsFloat <> 0 then
      cdsBGLExecutionRate.AsFloat := AdvRoundTo(GetBGLExecutionTotalPrice/cdsBGLTotalPrice.AsFloat*100)
    else
      cdsBGLExecutionRate.AsFloat := 0;
    cdsBGL.Post;
  end;
end;

function TBGLData.AllBGLTotalPrice: Double;
begin
  Result := 0;
  cdsBGL.First;
  while not cdsBGL.Eof do
  begin
    Result := Result + cdsBGLTotalPrice.AsFloat;
    cdsBGL.Next;
  end;
end;

procedure TBGLData.cdsBGBillsViewQuantitySetText(Sender: TField;
  const Text: String);
begin
  Sender.AsFloat := QuantityRoundTo(StrToFloatDef(Text, 0));
end;

procedure TBGLData.cdsBGBillsViewPriceSetText(Sender: TField;
  const Text: String);
begin
  Sender.AsFloat := PriceRoundTo(StrToFloatDef(Text, 0));
end;

procedure TBGLData.cdsBGLViewCodeChange(Sender: TField);
begin
  Sender.Tag := 1;
end;

procedure TBGLData.Close;
begin
  cdsBGL.IndexName := '';
  cdsBGL.Close;
  cdsBGBills.Close;
end;

function TBGLData.LocateBGL(const ACode: string): Boolean;
begin
  cdsBGL.IndexName := 'idxCode';
  try
    Result := cdsBGL.FindKey([ACode]);
  finally
    cdsBGL.IndexName := 'idxID';
  end;
end;

function TBGLData.LocateBGBills(ABGID: Integer;
  const AB_Code, AName, AUnit: string; APrice: Double): Boolean;
begin
  Result := False;
  cdsBGBills.First;
  while (not cdsBGBills.Eof) do
  begin
    if (cdsBGBillsBGID.AsInteger = ABGID) and
       SameText(cdsBGBillsB_Code.AsString, AB_Code) and
       SameText(cdsBGBillsName.AsString, AName) and
       SameText(cdsBGBillsUnits.AsString, AUnit) and
       (PriceRoundTo(cdsBGBillsPrice.AsFloat - APrice) = 0) then
    begin
      Result := True;
      Break;
    end;
    cdsBGBills.Next;
  end;
end;

function TBGLData.AllCloudBGLWebID: string;
begin
  Result := '';
  cdsBGL.First;
  while not cdsBGL.Eof do
  begin
   if cdsBGLIsCloud.AsBoolean then
   begin
    if Result = '' then
      Result := IntToStr(cdsBGLWebID.AsInteger)
    else
      Result := Result + ',' + IntToStr(cdsBGLWebID.AsInteger);
   end;
   cdsBGL.Next;
  end;
end;

procedure TBGLData.LoadCloudBGL(const ABGLs: string);

  procedure AddCloudBGLBills(ABGLID: Integer; ABGBills: ISuperObject);
  var
    i, iNewID: Integer;
    vJ: ISuperObject;
  begin
    for i := 0 to ABGBills.AsArray.Length - 1 do
    begin
      iNewID := GetNewIDOfIndex(cdsBGBills);
      vJ := ABGBills.AsArray.O[i];
      cdsBGBills.Append;
      cdsBGBillsID.AsInteger := iNewID;
      cdsBGBillsBGID.AsInteger := ABGLID;
      cdsBGBillsB_Code.AsString := vJ.S['lnum'];
      cdsBGBillsName.AsString := vJ.S['lname'];
      cdsBGBillsUnits.AsString := vJ.S['unit'];
      cdsBGBillsPrice.AsFloat := vJ.D['unitprice'];
      cdsBGBillsQuantity.AsFloat := vJ.D['samount'];
      cdsBGBillsTotalPrice.AsFloat := TotalPriceRoundTo(cdsBGBillsPrice.AsFloat * cdsBGBillsQuantity.AsFloat);
      cdsBGBills.Post;
      UpdateBGLTotalPrice(ABGLID, cdsBGBillsTotalPrice.AsFloat);
    end;
  end;

  procedure AddCloudBGL(ABGL: ISuperObject);
  var
    iNewID, iCreatePhaseID: Integer;
    vBGBills: ISuperObject;
  begin
    iNewID := GetNewIDOfIndex(cdsBGL);
    iCreatePhaseID := TProjectData(FProjectData).PhaseIndex;
    cdsBGL.Append;
    cdsBGLID.AsInteger := iNewID;
    cdsBGLCode.AsString := ABGL.S['pnum'];
    cdsBGLName.AsString := ABGL.S['pname'];
    cdsBGLPos_Reason.AsString := ABGL.S['description'];
    cdsBGLDirection.AsString := ABGL.S['basis'];
    cdsBGLDrawingCode.AsString := ABGL.S['cnum'];
    cdsBGLApprovalCode.AsString := ABGL.S['bnum'];
    cdsBGLCreatePhaseID.AsInteger := iCreatePhaseID;
    cdsBGLBGLType.AsString := ABGL.S['changeNature'];
    cdsBGLIsCloud.AsBoolean := True;
    cdsBGLWebID.AsInteger := ABGL.I['cid'];
    cdsBGL.Post;
    AddCloudBGLBills(iNewID, ABGL.O['changeBills']);
  end;

var
  vJ: ISuperObject;
  i: Integer;
begin
  vJ := SO(ABGLs);
  try
    if not Assigned(vJ.AsArray) then Exit;
    for i := 0 to vJ.AsArray.Length - 1 do
      AddCloudBGL(vJ.AsArray.O[i]);
  finally
    vJ := nil;
  end;
end;

function TBGLData.GetBGLCanEdit(ASerialNo: Integer): Boolean;
var
  i: Integer;
  bk: TBookmark;
begin
  cdsBGLView.DisableControls;
  bk := cdsBGLView.GetBookmark;
  cdsBGLView.First;
  i := 0;
  while (i < ASerialNo) and not cdsBGLView.Eof do
  begin
    cdsBGLView.Next;
    Inc(i);
  end;
  if i = ASerialNo then
    Result := not cdsBGLViewIsCloud.AsBoolean
  else
    Result := False;
  cdsBGLView.GotoBookmark(bk);
  cdsBGLView.FreeBookmark(bk);
  cdsBGLView.EnableControls;
end;

procedure TBGLData.cdsBGLViewAfterScroll(DataSet: TDataSet);
begin
  if Assigned(FAfterCurrentBGLChanged) then
    FAfterCurrentBGLChanged;
end;

function TBGLData.DeleteWeb(AWebID: Integer): Boolean;
var
  sgs: TStrings;
  sUrl, sInfo: string;
begin
  Screen.Cursor := crHourGlass;
  sgs := TStringList.Create;
  try
    sgs.Add(Format('cid=%d', [AWebID]));
    sUrl := PHPWeb.MeasureURL + 'change/delete';
    Result := PHPWeb.UrlGet(sUrl, sgs, sInfo) = 1;
  finally
    sgs.Free;
    Screen.Cursor := crDefault;
  end;
end;

function TBGLData.GetTotalPrice: Double;
var
  fTotalPrice: Double;
begin
  fTotalPrice := 0;
  cdsBGL.First;
  while not cdsBGL.Eof do
  begin
    fTotalPrice := fTotalPrice + cdsBGLTotalPrice.AsFloat;
    cdsBGL.next;
  end;
  Result := fTotalPrice;
end;

function TBGLData.GetEndTotalPrice(AEndPhase: Integer): Double;
var
  fTotalPrice: Double;
begin
  fTotalPrice := 0;
  cdsBGL.First;
  while not cdsBGL.Eof do
  begin
    if (cdsBGLCreatePhaseID.AsInteger <= AEndPhase) then
      fTotalPrice := fTotalPrice + cdsBGLTotalPrice.AsFloat;
    cdsBGL.next;
  end;
  Result := fTotalPrice;
end;

end.