dbsumlst.pas

最新的 DBGRIDEH4.0

begin
  if (Assigned(OldAfterCancel)) then
    OldAfterCancel(DataSet);
  FTryedInsert := False;
end;


function TDBSumListProducer.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TDBSumListProducer.Update;
begin
  if (csLoading in FOwner.ComponentState) then Exit;
  if (csDestroying in FOwner.ComponentState) then Exit; 
  {if (FSumCollection.Count = 0) then begin
    if FEventsOverloaded then ReturnEvents;
  end else begin
    if not FEventsOverloaded then SetDataSetEvents;
    RecalcAll;
  end;}
  RecalcAll;
end;

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

function TDBSumListProducer.GetRecNo: Integer;
begin
  if not DataSet.IsSequenced and VirtualRecords and Active then
    Result := FindVirtualRecord(DataSet.Bookmark) + 1
  else
    Result := DataSet.RecNo;
end;

procedure TDBSumListProducer.SetRecNo(const Value: Integer);
begin
  if not DataSet.IsSequenced and VirtualRecords and Active then
    DataSet.Bookmark := FVirtualRecList[Value - 1]
  else
    DataSet.RecNo := Value;
end;

function TDBSumListProducer.RecordCount: Integer;
begin
  if Assigned(DataSet) and not DataSet.IsSequenced and VirtualRecords and Active then
    Result := FVirtualRecList.Count
  else if Assigned(DataSet) then
    Result := DataSet.RecordCount
  else Result := 0;
end;

function TDBSumListProducer.IsSequenced: Boolean;
begin
  Result := (Assigned(DataSet) and DataSet.IsSequenced) or
    (Assigned(DataSet) and VirtualRecords and Active and not ((FVirtualRecList.Count = 0) and not (DataSet.EOF and DataSet.BOF)));
//  if VirtualRecords and Active and (FVirtualRecList.Count = 0) and not (DataSet.EOF and DataSet.BOF) then // Not yet recalculated
//    Result := False;
end;

function TDBSumListProducer.FindVirtualRecord(Bookmark: TBookmarkStr): Integer;
var
  C: Integer;
begin
  Result := -1;
  if FOldRecNo = -1 then FOldRecNo := 0;

  if FVirtualRecList.Count = 0 then Exit;
  if FOldRecNo >= FVirtualRecList.Count then FOldRecNo := 0; //Raise Exception.Create('Unexpected error -1 in function FindVirtualRecord');

  C := DataSetCompareBookmarks(DataSet, FVirtualRecList[FOldRecNo], Bookmark);

  if (C > 0) then
    while C <> 0 do
    begin
      Dec(FOldRecNo);
      if (FOldRecNo < 0) then Exit; //Raise Exception.Create('Unexpected error -2 in function FindVirtualRecord');
      C := DataSetCompareBookmarks(DataSet, FVirtualRecList[FOldRecNo], Bookmark);
    end
  else if (C < 0) then
    while C <> 0 do
    begin
      Inc(FOldRecNo);
      if (FOldRecNo >= FVirtualRecList.Count) then Exit; //Raise Exception.Create('Unexpected error -3 in function FindVirtualRecord');
      C := DataSetCompareBookmarks(DataSet, FVirtualRecList[FOldRecNo], Bookmark);
    end;

  Result := FOldRecNo;
end;


//
//  TDBSum
//

procedure TDBSum.Assign(Source: TPersistent);
begin
  if Source is TDBSum then
  begin
    GroupOperation := TDBSum(Source).GroupOperation;
    FieldName := TDBSum(Source).FieldName;
    Value := TDBSum(Source).Value;
    SumValue := TDBSum(Source).SumValue;
  end
  else inherited Assign(Source);
end;

constructor TDBSum.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  // Delphi8 set default value for FFieldName to 'null' string. Why?????
  FFieldName := '';
end;

procedure TDBSum.SetFieldName(const Value: String);
begin
  if (FFieldName = Value) then Exit;
  FFieldName := Value;
  Changed(False);
end;

procedure TDBSum.SetGroupOperation(const Value: TGroupOperation);
begin
  if (FGroupOperation = Value) then Exit;
  FGroupOperation := Value;
  Changed(False);
end;

//
//  TDBSumCollection
//

function TDBSumCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TDBSumCollection.GetItem(Index: Integer): TDBSum;
begin
  Result := TDBSum(inherited GetItem(Index));
end;

procedure TDBSumCollection.SetItem(Index: Integer; Value: TDBSum);
begin
  inherited SetItem(Index, Value);
end;

procedure TDBSumCollection.Update(Item: TCollectionItem);
begin
  TDBSumListProducer(FOwner).Update;
end;

function TDBSumCollection.GetSumByOpAndFName(
  AGroupOperation: TGroupOperation; AFieldName: String): TDBSum;
var i: Integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do
  begin
    if (AGroupOperation = Items[i].GroupOperation) and
      (AnsiCompareText(AFieldName, Items[i].FieldName) = 0) then
    begin
      Result := Items[i];
      Exit;
    end;
  end;
end;


{ TDBSumList }

constructor TDBSumList.Create(AOwner: TComponent);
begin
  inherited;
  FSumListProducer := TDBSumListProducer.Create(Self);
end;

destructor TDBSumList.Destroy;
begin
  inherited;
  FreeAndNil(FSumListProducer);
end;


procedure TDBSumList.Activate(ARecalcAll: Boolean);
begin
  FSumListProducer.Activate(ARecalcAll);
end;

procedure TDBSumList.ClearSumValues;
begin
  FSumListProducer.ClearSumValues;
end;

procedure TDBSumList.DataSetAfterClose(DataSet: TDataSet);
begin
  FSumListProducer.DataSetAfterClose(DataSet);
end;

procedure TDBSumList.DataSetAfterEdit(DataSet: TDataSet);
begin
  FSumListProducer.DataSetAfterEdit(DataSet);
end;

procedure TDBSumList.DataSetAfterInsert(DataSet: TDataSet);
begin
  FSumListProducer.DataSetAfterInsert(DataSet);
end;

procedure TDBSumList.DataSetAfterOpen(DataSet: TDataSet);
begin
  FSumListProducer.DataSetAfterOpen(DataSet);
end;

procedure TDBSumList.DataSetAfterPost(DataSet: TDataSet);
begin
  FSumListProducer.DataSetAfterPost(DataSet);
end;

procedure TDBSumList.DataSetAfterScroll(DataSet: TDataSet);
begin
  FSumListProducer.DataSetAfterScroll(DataSet);
end;

procedure TDBSumList.DataSetBeforeDelete(DataSet: TDataSet);
begin
  FSumListProducer.DataSetBeforeDelete(DataSet);
end;

procedure TDBSumList.Deactivate(AClearSumValues: Boolean);
begin
  FSumListProducer.Deactivate(AClearSumValues);
end;

procedure TDBSumList.DoSumListChanged;
begin
  FSumListProducer.DoSumListChanged;
end;

procedure TDBSumList.Loaded;
begin
  inherited;
  FSumListProducer.Loaded;
end;

procedure TDBSumList.MasterDataSetAfterScroll(DataSet: TDataSet);
begin
  FSumListProducer.MasterDataSetAfterScroll(DataSet);
end;

procedure TDBSumList.RecalcAll;
begin
  FSumListProducer.RecalcAll;
end;

procedure TDBSumList.SetActive(const Value: Boolean);
begin
  FSumListProducer.SetActive(Value);
end;

procedure TDBSumList.SetDataSet(Value: TDataSet);
begin
  FSumListProducer.SetDataSet(Value);
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TDBSumList.SetDataSetEvents;
begin
  FSumListProducer.SetDataSetEvents;
end;

procedure TDBSumList.SetExternalRecalc(const Value: Boolean);
begin
  FSumListProducer.SetExternalRecalc(Value);
end;

procedure TDBSumList.SetSumCollection(const Value: TDBSumCollection);
begin
  FSumListProducer.SetSumCollection(Value);
end;

function TDBSumList.GetActive: Boolean;
begin
  Result := FSumListProducer.Active;
end;

function TDBSumList.GetDataSet: TDataSet;
begin
  Result := FSumListProducer.DataSet;
end;

function TDBSumList.GetExternalRecalc: Boolean;
begin
  Result := FSumListProducer.ExternalRecalc;
end;

function TDBSumList.GetOnRecalcAll: TNotifyEvent;
begin
  Result := FSumListProducer.OnRecalcAll;
end;

function TDBSumList.GetSumCollection: TDBSumCollection;
begin
  Result := FSumListProducer.SumCollection;
end;

function TDBSumList.GetSumListChanged: TNotifyEvent;
begin
  Result := FSumListProducer.SumListChanged;
end;

procedure TDBSumList.SetOnRecalcAll(const Value: TNotifyEvent);
begin
  FSumListProducer.OnRecalcAll := Value;
end;

procedure TDBSumList.SetSumListChanged(const Value: TNotifyEvent);
begin
  FSumListProducer.SumListChanged := Value;
end;

function TDBSumList.IsSequenced: Boolean;
begin
  Result := FSumListProducer.IsSequenced;
end;

function TDBSumList.RecordCount: Integer;
begin
  Result := FSumListProducer.RecordCount;
end;

procedure TDBSumList.SetVirtualRecords(const Value: Boolean);
begin
  FSumListProducer.VirtualRecords := Value;
end;

function TDBSumList.GetVirtualRecords: Boolean;
begin
  Result := FSumListProducer.VirtualRecords;
end;

function TDBSumList.GetRecNo: Integer;
begin
  Result := FSumListProducer.RecNo;
end;

procedure TDBSumList.SetRecNo(const Value: Integer);
begin
  FSumListProducer.RecNo := Value;
end;

procedure TDBSumList.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
    if (AComponent is TDataSet) and (AComponent = DataSet) then
    begin
      DataSet := nil;
    end;
  end;
end;

function TDBSumList.GetOnAfterRecalcAll: TNotifyEvent;
begin
  Result := FSumListProducer.OnAfterRecalcAll;
end;

procedure TDBSumList.SetOnAfterRecalcAll(const Value: TNotifyEvent);
begin
  FSumListProducer.OnAfterRecalcAll := Value;
end;

end.