dbsumlst.pas

Delphi控件源码

{*******************************************************}
{                                                       }
{                       EhLib v1.56                     }
{                   TDBSumList component                }
{                                                       }
{   Copyright (c) 1998, 2000 by Dmitry V. Bolshakov     }
{                                                       }
{*******************************************************}

//{$define eval}

unit DBSumLst;

interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB,
  TypInfo {,dbugintf} ;

type
  TGroupOperation = (goSum,goCount);

  TDBSum = class(TCollectionItem)
  private
    procedure SetGroupOperation(const Value: TGroupOperation);
    procedure SetFieldName(const Value: String);
  protected
    FGroupOperation:TGroupOperation;
    FFieldName:String;
    Value:Currency;
  public
    SumValue:Currency;
    procedure Assign(Source: TPersistent); override;

  published
    property GroupOperation:TGroupOperation read FGroupOperation write SetGroupOperation;
    property FieldName:String read FFieldName write SetFieldName;
  end;

  TDBSumCollection = class(TCollection)
  protected
    FOwner:TPersistent;
    function GetOwner:TPersistent; override;
    function GetItem(Index: Integer): TDBSum;
    procedure SetItem(Index: Integer; Value: TDBSum);
    procedure Update(Item: TCollectionItem); override;
  public
    property Items[Index: Integer]: TDBSum read GetItem write SetItem; default;
    function GetSumByOpAndFName(AGroupOperation: TGroupOperation; AFieldName:String):TDBSum;
  end;



  TDBSumListProducer = class(TPersistent)
  private
    FVirtualRecords: Boolean;
    procedure SetVirtualRecords(const Value: Boolean);
    function GetRecNo: Integer;
    procedure SetRecNo(const Value: Integer);
  protected 
    FOwner:TComponent;

    FOnRecalcAll: TNotifyEvent;
    FExternalRecalc: Boolean;
    FSumCollection:TDBSumCollection;
    FDataSet:TDataSet;
    FMasterDataset:TDataset;
    FMasterPropInfo: PPropInfo;
    FSumListChanged:TNotifyEvent;

    Filtered:Boolean;
    Filter:String;
    Changing:Boolean;
    FActive: Boolean;
    FEventsOverloaded: Boolean;
    FDesignTimeWork:Boolean;
    FVirtualRecList: TList;
    FOldRecNo:Integer;
    FTryedInsert:Boolean;

    OldAfterEdit :TDataSetNotifyEvent;
    OldAfterInsert :TDataSetNotifyEvent;
    OldAfterOpen :TDataSetNotifyEvent;
    OldAfterPost :TDataSetNotifyEvent;
    OldAfterScroll :TDataSetNotifyEvent;
    OldBeforeDelete :TDataSetNotifyEvent;
    OldAfterClose :TDataSetNotifyEvent;
    OldAfterCancel:TDataSetNotifyEvent;
    OldMasterAfterScroll :TDataSetNotifyEvent;

    procedure DataSetAfterEdit(DataSet: TDataSet);
    procedure DataSetAfterInsert(DataSet: TDataSet);
    procedure DataSetAfterOpen(DataSet: TDataSet);
    procedure DataSetAfterPost(DataSet: TDataSet);
    procedure DataSetAfterScroll(DataSet: TDataSet);
    procedure DataSetBeforeDelete(DataSet: TDataSet);
    procedure DataSetAfterClose(DataSet: TDataSet);
    procedure DataSetAfterCancel(DataSet: TDataSet);
    function  GetOwner: TPersistent; override;
    function  GetMasterDataSet(APropInfo:PPropInfo): TDataSet;
    procedure MasterDataSetAfterScroll(DataSet: TDataSet);
    procedure ResetMasterInfo;
    procedure SetExternalRecalc(const Value: Boolean);
    procedure Update;
    procedure ReturnEvents;
    function  FindVirtualRecord(Bookmark:TBookmark):Integer; virtual;
    procedure DoSumListChanged;
    procedure SetActive(const Value: Boolean);
    procedure SetDataSet(Value:TDataSet);
    procedure Loaded;
    procedure SetSumCollection(const Value: TDBSumCollection);
  public
    constructor Create(AOwner:TComponent);
    destructor Destroy; override;
    procedure Activate(ARecalcAll: Boolean);
    procedure Assign(Source: TPersistent); override;
    procedure ClearSumValues; virtual;
    procedure Deactivate(AClearSumValues: Boolean);
    procedure RecalcAll; virtual;
    procedure SetDataSetEvents;
    function  RecordCount : Integer;
    function  IsSequenced: Boolean;


    property Active: Boolean read FActive write SetActive default True;
    property ExternalRecalc: Boolean read FExternalRecalc write SetExternalRecalc;
    property SumCollection:TDBSumCollection read FSumCollection write SetSumCollection;
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property VirtualRecords: Boolean read FVirtualRecords write SetVirtualRecords;
    property RecNo : Integer read GetRecNo write SetRecNo;

    property SumListChanged: TNotifyEvent read FSumListChanged write FSumListChanged;
    property OnRecalcAll: TNotifyEvent read FOnRecalcAll write FOnRecalcAll;
  end;

  TDBSumList = class(TComponent)
  private
    function GetActive: Boolean;
    function GetDataSet: TDataSet;
    function GetExternalRecalc: Boolean;
    function GetOnRecalcAll: TNotifyEvent;
    function GetSumCollection: TDBSumCollection;
    function GetSumListChanged: TNotifyEvent;
    procedure SetOnRecalcAll(const Value: TNotifyEvent);
    procedure SetSumListChanged(const Value: TNotifyEvent);
    procedure SetVirtualRecords(const Value: Boolean);
    function GetVirtualRecords: Boolean;
    function GetRecNo: Integer;
    procedure SetRecNo(const Value: Integer);
  protected
    FSumListProducer: TDBSumListProducer;

    procedure DataSetAfterEdit(DataSet: TDataSet);
    procedure DataSetAfterInsert(DataSet: TDataSet);
    procedure DataSetAfterOpen(DataSet: TDataSet);
    procedure DataSetAfterPost(DataSet: TDataSet);
    procedure DataSetAfterScroll(DataSet: TDataSet);
    procedure DataSetBeforeDelete(DataSet: TDataSet);
    procedure DataSetAfterClose(DataSet: TDataSet);
    procedure MasterDataSetAfterScroll(DataSet: TDataSet);
    procedure SetExternalRecalc(const Value: Boolean);

    procedure DoSumListChanged;
    procedure SetActive(const Value: Boolean);
    procedure SetDataSet(Value:TDataSet);
    procedure Loaded; override;
    procedure SetSumCollection(const Value: TDBSumCollection);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Activate(ARecalcAll: Boolean);
    procedure ClearSumValues; virtual;
    procedure Deactivate(AClearSumValues: Boolean);
    procedure RecalcAll; virtual;
    procedure SetDataSetEvents;
    function  RecordCount: Integer;
    function  IsSequenced: Boolean;
    property RecNo : Integer read GetRecNo write SetRecNo;
  published
    property Active: Boolean read GetActive write SetActive default True;
    property ExternalRecalc: Boolean read GetExternalRecalc write SetExternalRecalc;
    property SumCollection:TDBSumCollection read GetSumCollection write SetSumCollection;
    property DataSet: TDataSet read GetDataSet write SetDataSet;
    property VirtualRecords: Boolean read GetVirtualRecords write SetVirtualRecords;
    property SumListChanged: TNotifyEvent read GetSumListChanged write SetSumListChanged;
    property OnRecalcAll: TNotifyEvent read GetOnRecalcAll write SetOnRecalcAll;
  end;

//procedure Register;

implementation


//procedure Register;
//begin
//  RegisterComponents('Data Controls', [TDBSumList]);
//end;

//
//  TDBSumListProducer
//

constructor TDBSumListProducer.Create(AOwner:TComponent);
begin
  inherited Create;
{$ifdef eval}
  {$INCLUDE eval}
{$endif}
  FDesignTimeWork := False;
  FOwner := AOwner;
  FSumCollection := TDBSumCollection.Create(TDBSum);
  FSumCollection.FOwner := Self;
  FActive := True;
  FVirtualRecList := TList.Create;
end;

destructor TDBSumListProducer.Destroy;
begin
  Deactivate(False);
  FVirtualRecList.Free;
  FSumCollection.Free;
  inherited;
end;


procedure TDBSumListProducer.Assign(Source: TPersistent);
begin
  if Source is TDBSumListProducer then begin
    Active := TDBSumListProducer(Source).Active;
    ExternalRecalc := TDBSumListProducer(Source).ExternalRecalc;
    SumCollection.Assign(TDBSumListProducer(Source).SumCollection);
    DataSet := TDBSumListProducer(Source).DataSet;
    SumListChanged := TDBSumListProducer(Source).SumListChanged;
    OnRecalcAll := TDBSumListProducer(Source).OnRecalcAll;
  end
  else inherited Assign(Source);
end;

{ obsolete
function GetMasterSource(ADataSet:TDataSet): TDataSet;
var PropInfo: PPropInfo;
    PropValue: TDataSource;
begin
  Result := nil;
  PropValue := nil;
  PropInfo := GetPropInfo(ADataSet.ClassInfo, 'MasterSource');
  if (PropInfo <> nil) then begin
    if PropInfo^.PropType^.Kind = tkClass then
      try
        PropValue := (TObject(GetOrdProp(ADataSet, PropInfo)) as TDataSource);
      except // if PropInfo is not TDataSource or not inherited of
      end;
  end;
  if (PropValue <> nil) then Result := PropValue.DataSet;
end;
}
              
function TDBSumListProducer.GetMasterDataSet(APropInfo:PPropInfo): TDataSet;
var  PropValue: TDataSource;
begin
  Result := nil;
  PropValue := nil;
  if (APropInfo <> nil) then begin
    if APropInfo^.PropType^.Kind = tkClass then
      try
        PropValue := (TObject(GetOrdProp(FDataSet, APropInfo)) as TDataSource);
      except // if PropInfo is not TDataSource or not inherited of
      end;
  end;
  if (PropValue <> nil) then Result := PropValue.DataSet;
end;

procedure TDBSumListProducer.ResetMasterInfo;
begin
  //if (AMasterSource = FMasterDataSet) then Exit;
  if Assigned(FMasterDataSet) then begin
      FMasterDataSet.AfterScroll := OldMasterAfterScroll;
  end;
  OldMasterAfterScroll := nil;
  FMasterPropInfo := GetPropInfo(FDataSet.ClassInfo, 'MasterSource');
  FMasterDataSet := GetMasterDataSet(FMasterPropInfo);
  if Assigned(FMasterDataSet) then OldMasterAfterScroll := FMasterDataSet.AfterScroll;
  if Assigned(FMasterDataSet) then FMasterDataSet.AfterScroll := MasterDataSetAfterScroll;
end;

procedure TDBSumListProducer.SetDataSetEvents;
begin
  if Assigned(FDataSet) and (FEventsOverloaded = False) then begin // Set new events

    FMasterPropInfo := GetPropInfo(FDataSet.ClassInfo, 'MasterSource');
    FMasterDataSet := GetMasterDataSet(FMasterPropInfo);

    OldAfterEdit := FDataSet.AfterEdit;
    OldAfterInsert := FDataSet.AfterInsert;
    OldAfterOpen := FDataSet.AfterOpen;
    OldAfterPost := FDataSet.AfterPost;
    OldAfterScroll := FDataSet.AfterScroll;
    OldBeforeDelete := FDataSet.BeforeDelete;
    OldAfterClose := FDataSet.AfterClose;
    OldAfterCancel := FDataSet.AfterCancel;
    if Assigned(FMasterDataSet) then OldMasterAfterScroll := FMasterDataSet.AfterScroll;

    FDataSet.AfterEdit := DataSetAfterEdit;
    FDataSet.AfterInsert := DataSetAfterInsert;
    FDataSet.AfterOpen := DataSetAfterOpen;
    FDataSet.AfterPost := DataSetAfterPost;
    FDataSet.AfterScroll := DataSetAfterScroll;
    FDataSet.BeforeDelete := DataSetBeforeDelete;
    FDataSet.AfterClose := DataSetAfterClose;
    FDataSet.AfterCancel := DataSetAfterCancel;
    if Assigned(FMasterDataSet) then FMasterDataSet.AfterScroll := MasterDataSetAfterScroll;

    FEventsOverloaded := True;

  end;
end;

procedure TDBSumListProducer.ReturnEvents;
var i: Integer;
begin
  if Assigned(FDataSet) and (FEventsOverloaded = True) then begin // Return old events
    FDataSet.AfterEdit := OldAfterEdit;
    FDataSet.AfterInsert := OldAfterInsert;
    FDataSet.AfterOpen := OldAfterOpen;
    FDataSet.AfterPost := OldAfterPost;
    FDataSet.AfterScroll := OldAfterScroll;
    FDataSet.BeforeDelete := OldBeforeDelete;
    FDataSet.AfterClose := OldAfterClose;
    FDataSet.AfterCancel := OldAfterCancel;
    if Assigned(FMasterDataSet) then begin
        FMasterDataSet.AfterScroll := OldMasterAfterScroll;
    end;

    OldMasterAfterScroll := nil;
    OldAfterEdit := nil;
    OldAfterInsert := nil;
    OldAfterOpen := nil;
    OldAfterPost := nil;
    OldAfterScroll := nil;
    OldBeforeDelete := nil;
    OldAfterClose := nil;
    OldAfterCancel := nil;