dbsumlst.pas

最新的 DBGRIDEH4.0

  item: TDBSum;
  NeedRecalc: Boolean;
begin
  if (not FDesignTimeWork and (csDesigning in FOwner.ComponentState)) or
    (csLoading in FOwner.ComponentState) or (Active = False) or not Assigned(DataSet) or
    (DataSet.Active = False) or (FEventsOverloaded = False) then Exit;
  try
    ClearSumValues;
    FOldRecNo := -1;

    if Assigned(OnRecalcAll) then OnRecalcAll(Self);
    if ExternalRecalc then Exit;

    NeedRecalc := False;
    for i := 0 to FSumCollection.Count - 1 do
      if (TDBSum(FSumCollection.Items[i]).GroupOperation = goCount) or
        (TDBSum(FSumCollection.Items[i]).FieldName <> '') then
      begin
        NeedRecalc := True;
        Break;
      end;

    if not FDataSet.IsSequenced and VirtualRecords then
      NeedRecalc := True;

    if NeedRecalc then
    begin
      FDataSet.DisableControls;
//      for i := 0 to FVirtualRecList.Count - 1
//        do FDataSet.FreeBookmark(FVirtualRecList[i]);
      FVirtualRecList.Clear;
      Changing := True;

      FDataSet.First;
      while FDataSet.Eof = False do
      begin
        for i := 0 to FSumCollection.Count - 1 do
        begin
          item := TDBSum(FSumCollection.Items[i]);
          if (item.GroupOperation = goCount) or (item.FieldName <> '') then
          begin
            case Item.GroupOperation of
              goSum:
                if (FDataSet.FieldByName(Item.FieldName).IsNull = False) then
                  Item.SumValue := Item.SumValue + FDataSet.FieldByName(Item.FieldName).AsFloat;
              goCount:
                if (Item.FieldName = '') or not FDataSet.FieldByName(Item.FieldName).IsNull then
                  Item.SumValue := Item.SumValue + 1;
              goAvg:
                begin
                  if (FDataSet.FieldByName(Item.FieldName).IsNull = False) then
                    Inc(Item.FNotNullRecordCount);
                  Item.FSumValueAsSum := Item.FSumValueAsSum + FDataSet.FieldByName(Item.FieldName).AsFloat;
                end;
            end;
          end;
        end;
        if not FDataSet.IsSequenced and VirtualRecords then
          FVirtualRecList.Add(FDataSet.Bookmark);
        FDataSet.Next;
      end;
      FDataSet.First;

      for i := 0 to FSumCollection.Count - 1 do
        with TDBSum(FSumCollection.Items[i]) do
          if GroupOperation = goAvg then
            if FNotNullRecordCount <> 0
              then SumValue := FSumValueAsSum / FNotNullRecordCount
              else SumValue := 0;

      FDataSet.EnableControls;
    end;

    if Assigned(OnAfterRecalcAll) then OnAfterRecalcAll(Self);

////  SumValue := Cur;
  finally
    Filtered := FDataSet.Filtered;
    Filter := FDataSet.Filter;
    Changing := False;
    DoSumListChanged;
  end;
end;

procedure TDBSumListProducer.DataSetAfterEdit(DataSet: TDataSet);
var i: Integer;
  item: TDBSum;
begin
  if (Active = False) then Exit;

  for i := 0 to FSumCollection.Count - 1 do
  begin
    item := TDBSum(FSumCollection.Items[i]);
    if (item.GroupOperation = goCount) or (item.FieldName <> '') then
    begin
      case Item.GroupOperation of
        goSum, goAvg:
          begin
            if (FDataSet.FieldByName(Item.FieldName).IsNull = False)
              then Item.Value := FDataSet.FieldByName(Item.FieldName).AsFloat
              else Item.Value := 0;
            Item.VarValue := FDataSet.FieldByName(Item.FieldName).AsVariant;
          end;
        goCount:
          if (Item.FieldName = '') or not FDataSet.FieldByName(Item.FieldName).IsNull
            then Item.Value := 1
            else Item.Value := 0;
      end;
    end;
  end;
  if (Assigned(OldAfterEdit)) then
    OldAfterEdit(DataSet);
end;

procedure TDBSumListProducer.DataSetAfterInsert(DataSet: TDataSet);
var i: Integer;
  Item: TDBSum;
  ABookMark: TBookmarkStr;
begin
  if Active then
  begin
    for i := 0 to FSumCollection.Count - 1 do
    begin
      Item := TDBSum(FSumCollection.Items[i]);
      if (item.GroupOperation = goCount) or (item.FieldName <> '') then
      begin
        case Item.GroupOperation of
          goSum, goAvg:
            begin
              Item.Value := 0;
              Item.VarValue := Null;
            end;
          goCount:
            if not (Item.FieldName = '') and not FDataSet.FieldByName(Item.FieldName).IsNull
              then Item.Value := 1
              else Item.Value := 0;
        end;
      end;
    end;

    if not FDataSet.IsSequenced and VirtualRecords then
    begin
      ABookMark := FDataSet.Bookmark;
      if ABookMark <> ''
        then FVirtualRecList.Add(ABookMark)
        else FTryedInsert := True;
    end;
  end;
  if (Assigned(OldAfterInsert)) then
    OldAfterInsert(DataSet);
end;

procedure TDBSumListProducer.DataSetAfterOpen(DataSet: TDataSet);
begin
  if Active then RecalcAll;
  if (Assigned(OldAfterOpen)) then
    OldAfterOpen(DataSet);
end;

procedure TDBSumListProducer.DataSetAfterPost(DataSet: TDataSet);
var i: Integer;
  item: TDBSum;
  ARecNo, C: Integer;
begin
  if Active then
  begin
    for i := 0 to FSumCollection.Count - 1 do
    begin
      item := TDBSum(FSumCollection.Items[i]);
      if (item.GroupOperation = goCount) or (item.FieldName <> '') then
      begin
        case Item.GroupOperation of
          goSum:
            if (FDataSet.FieldByName(Item.FieldName).IsNull = False) then
              Item.SumValue := Item.SumValue - Item.Value + FDataSet.FieldByName(Item.FieldName).AsFloat
            else
              Item.SumValue := Item.SumValue - Item.Value;
          goCount:
            if (Item.FieldName = '') or not FDataSet.FieldByName(Item.FieldName).IsNull
              then Item.SumValue := Item.SumValue - Item.Value + 1
              else Item.SumValue := Item.SumValue - Item.Value;
          goAvg:
            begin
              if (FDataSet.FieldByName(Item.FieldName).IsNull = False) then
              begin
                if Item.VarValue = Null then Inc(Item.FNotNullRecordCount);
                Item.FSumValueAsSum := Item.FSumValueAsSum - Item.Value + FDataSet.FieldByName(Item.FieldName).AsFloat
              end else
              begin
                if Item.VarValue <> Null then Dec(Item.FNotNullRecordCount);
                Item.FSumValueAsSum := Item.FSumValueAsSum - Item.Value;
              end;
              if Item.FNotNullRecordCount <> 0
                then Item.SumValue := Item.FSumValueAsSum / Item.FNotNullRecordCount
                else Item.SumValue := 0;
            end;
        end;
      end;
    end;

    if not FDataSet.IsSequenced and VirtualRecords and FTryedInsert = True then
    begin
      ARecNo := FOldRecNo;
      if (ARecNo = -1) or (ARecNo >= FVirtualRecList.Count) then ARecNo := 0;
      if (FVirtualRecList.Count > 0) then
        C := DataSetCompareBookmarks(DataSet, FVirtualRecList[ARecNo], FDataSet.Bookmark)
      else
        C := 0;
      if (C > 0) then
        while C > 0 do
        begin
          if (ARecNo = 0) then Break;
          Dec(ARecNo);
          C := DataSetCompareBookmarks(DataSet, FVirtualRecList[ARecNo], FDataSet.Bookmark);
        end
      else if (C < 0) then
        while C < 0 do
        begin
          Inc(ARecNo);
          if (ARecNo >= FVirtualRecList.Count) then Break;
          C := DataSetCompareBookmarks(DataSet, FVirtualRecList[ARecNo], FDataSet.Bookmark);
        end;
      FVirtualRecList.Insert(ARecNo, FDataSet.Bookmark);
      FTryedInsert := False;
    end;
    DoSumListChanged;
  end;
  if (Assigned(OldAfterPost)) then
    OldAfterPost(DataSet);
end;

procedure TDBSumListProducer.DataSetAfterScroll(DataSet: TDataSet);
begin
  if (Assigned(OldAfterScroll)) then
    OldAfterScroll(DataSet);
  if (Active = False) then Exit;

  if (Changing = False) then
  begin
    if ((DataSet.Filtered and (Filter <> DataSet.Filter)) or (Filtered <> DataSet.Filtered)) then
      RecalcAll;
   {else if (FMasterDataset <> GetMasterDataSet(FMasterPropInfo)) then begin
     ResetMasterInfo;
     RecalcAll;
   end;}
  end;
end;

procedure TDBSumListProducer.DataSetBeforeDelete(DataSet: TDataSet);
var i: Integer;
  item: TDBSum;
begin
  if (Assigned(OldBeforeDelete)) then
    OldBeforeDelete(DataSet);
  if (Active = False) then Exit;

  for i := 0 to FSumCollection.Count - 1 do
  begin
    item := TDBSum(FSumCollection.Items[i]);
    if (item.GroupOperation = goCount) or (item.FieldName <> '') then
    begin
      case Item.GroupOperation of
        goSum:
          Item.SumValue := Item.SumValue - FDataSet.FieldByName(Item.FieldName).AsFloat;
        goCount:
          if (Item.FieldName = '') or not FDataSet.FieldByName(Item.FieldName).IsNull
            then Item.SumValue := Item.SumValue - 1;
        goAvg:
          begin
            Item.FSumValueAsSum := Item.FSumValueAsSum - FDataSet.FieldByName(Item.FieldName).AsFloat;
            if not FDataSet.FieldByName(Item.FieldName).IsNull then Dec(Item.FNotNullRecordCount);
            if Item.FNotNullRecordCount <> 0
              then Item.SumValue := Item.FSumValueAsSum / Item.FNotNullRecordCount
              else Item.SumValue := 0;
          end;
      end;
    end;
  end;

  if not FDataSet.IsSequenced and VirtualRecords then
  begin
    i := FindVirtualRecord(FDataSet.Bookmark);
    if i >= 0 then
    begin
//      FDataSet.FreeBookmark(FVirtualRecList[i]);
      FVirtualRecList.Delete(i);
    end;
  end;

  DoSumListChanged;
end;

procedure TDBSumListProducer.DataSetAfterClose(DataSet: TDataSet);
//var
//  i: integer;
begin
  if Active then
  begin
    ClearSumValues;
    DoSumListChanged;
    Changing := False;
  end;

//  if Assigned(FDataSet) and Assigned(FVirtualRecList) and (FVirtualRecList.Count > 0) then
//    for i := 0 to FVirtualRecList.Count - 1 do
//      FDataSet.FreeBookmark(FVirtualRecList[i]);
  FVirtualRecList.Clear;

  if (Assigned(OldAfterClose)) then
    OldAfterClose(DataSet);
end;

procedure TDBSumListProducer.SetSumCollection(const Value: TDBSumCollection);
begin
  FSumCollection.Assign(Value);
end;

procedure TDBSumListProducer.SetActive(const Value: Boolean);
begin
  if (FActive = Value) then Exit;
  if (Value = True) then Activate(True);
  if (Value = False) then Deactivate(True);
end;

procedure TDBSumListProducer.Activate(ARecalcAll: Boolean);
begin
  FActive := True;
  if (csLoading in FOwner.ComponentState) or
    (not FDesignTimeWork and (csDesigning in FOwner.ComponentState)) then Exit;
  SetDataSetEvents;
  if ARecalcAll then RecalcAll;
end;

procedure TDBSumListProducer.Deactivate(AClearSumValues: Boolean);
begin
  FActive := False;
  if (csLoading in FOwner.ComponentState) or
    (not FDesignTimeWork and (csDesigning in FOwner.ComponentState)) then Exit;
  ReturnEvents;
  if AClearSumValues then ClearSumValues;
end;

procedure TDBSumListProducer.DoSumListChanged;
begin
  if Assigned(SumListChanged) then SumListChanged(Self);
end;

procedure TDBSumListProducer.ClearSumValues;
var i: Integer;
  item: TDBSum;
begin
  for i := 0 to FSumCollection.Count - 1 do
  begin
    item := TDBSum(FSumCollection.Items[i]);
    item.SumValue := 0;
    item.Value := 0;
    item.FSumValueAsSum := 0;
    item.FNotNullRecordCount := 0;
  end;
  DoSumListChanged;
end;

procedure TDBSumListProducer.SetExternalRecalc(const Value: Boolean);
begin
  if (FExternalRecalc = Value) then Exit;
  FExternalRecalc := Value;
  RecalcAll;
end;


procedure TDBSumListProducer.MasterDataSetAfterScroll(DataSet: TDataSet);
begin
  if (Assigned(OldMasterAfterScroll)) then
    OldMasterAfterScroll(DataSet);

  if (Active = False) then Exit;
  if Changing = False then RecalcAll;
end;

procedure TDBSumListProducer.DataSetAfterCancel(DataSet: TDataSet);