dbsumlst.pas

我对ehlib的修改,优化了计算效率,修正了其本身存在的BUG

    (DataSet.Active = False) or (FEventsOverloaded = False) then Exit;
  Begin
    //累计统计次数
    Inc(iCount);
    If iCount>1 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
        INC(DoCount);
        FDataSet.DisableControls;
  //      for i := 0 to FVirtualRecList.Count - 1
  //        do FDataSet.FreeBookmark(FVirtualRecList[i]);
        FVirtualRecList.Clear;
        Changing := True;
        If FDataSet.RecordCount>0 Then 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 Not FDataSet.FieldByName(Item.FieldName).IsNull then
                    Item.SumValue := Item.SumValue + FDataSet.FieldByName(Item.FieldName).Value;
                goCount:
                  if (Item.FieldName = '') or (not FDataSet.FieldByName(Item.FieldName).IsNull) then
                    Item.SumValue := Item.SumValue + 1;
                goAvg:
                  begin
                    if Not FDataSet.FieldByName(Item.FieldName).IsNull then
                    Begin
                      Inc(Item.FNotNullRecordCount);
                      Item.FSumValueAsSum := Item.FSumValueAsSum + FDataSet.FieldByName(Item.FieldName).Value;
                    End;
                  end;
              end;
            end;
          end;
          if not FDataSet.IsSequenced and VirtualRecords then
            FVirtualRecList.Add(FDataSet.Bookmark);
          FDataSet.Next;
        end;
        If FDataSet.RecordCount>0 Then 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;
      ///Showmessage(IntToStr(DoCount));

      if Assigned(OnAfterRecalcAll) then OnAfterRecalcAll(Self);

  ////  SumValue := Cur;
    finally
      Filtered := FDataSet.Filtered;
      Filter := FDataSet.Filter;
      Changing := False;
      DoSumListChanged;
    end;
  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 DoCount=1 Then Begin Inc(DoCount); Exit; End;
  iCount :=0;
  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
          Dec(ARecNo);
          if (ARecNo < 0) then Break;
          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
    //Application.MessageBox(PChar(DataSet.Filter),'提示',MB_OK+48);
    if ((DataSet.Filtered and (Filter <> DataSet.Filter)) or (Filtered <> DataSet.Filtered)) then
    Begin
      iCount :=0;
      RecalcAll;
    End;
   {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
  Begin
   iCount :=0;
   RecalcAll;
  End;
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);