dbsumlst.pas

考勤管理是企业内部管理的重要环节和基础

{*******************************************************}
{                                                       }
{                       EhLib v2.2                      }
{                   TDBSumList component                }
{                                                       }
{   Copyright (c) 1998, 2001 by Dmitry V. Bolshakov     }
{                                                       }
{*******************************************************}

{$I EhLib.Inc}

unit DBSumLst;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB,
{$IFDEF EH_LIB_6} Variants, {$ENDIF}
  TypInfo {,dbugintf} ;

type
  TGroupOperation = (goSum,goAvg,goCount);

  TDBSum = class(TCollectionItem)
  private
    procedure SetGroupOperation(const Value: TGroupOperation);
    procedure SetFieldName(const Value: String);
  protected
    FFieldName:String;
    FGroupOperation:TGroupOperation;
    Value:Currency;
    // For Average
    FNotNullRecordCount:Integer;
    FSumValueAsSum:Currency;
    VarValue:Variant;
  public
    SumValue:Currency;
    procedure Assign(Source: TPersistent); override;
  published
    property FieldName:String read FFieldName write SetFieldName;
    property GroupOperation:TGroupOperation read FGroupOperation write SetGroupOperation;
  end;

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

  TDBSumListProducer = class(TPersistent)
  private
    FVirtualRecords: Boolean;
    function GetRecNo: Integer;
    procedure SetRecNo(const Value: Integer);
    procedure SetVirtualRecords(const Value: Boolean);
  protected
    Changing:Boolean;
    FActive: Boolean;
    FDataSet:TDataSet;
    FDesignTimeWork:Boolean;
    FEventsOverloaded: Boolean;
    FExternalRecalc: Boolean;
    Filter:String;
    Filtered:Boolean;
    FMasterDataset:TDataset;
    FMasterPropInfo: PPropInfo;
    FOldRecNo:Integer;
    FOnRecalcAll: TNotifyEvent;
    FOwner:TComponent;
    FSumCollection:TDBSumCollection;
    FSumListChanged:TNotifyEvent;
    FTryedInsert:Boolean;
    FVirtualRecList: TList;
    OldAfterCancel:TDataSetNotifyEvent;
    OldAfterClose :TDataSetNotifyEvent;
    OldAfterEdit :TDataSetNotifyEvent;
    OldAfterInsert :TDataSetNotifyEvent;
    OldAfterOpen :TDataSetNotifyEvent;
    OldAfterPost :TDataSetNotifyEvent;
    OldAfterScroll :TDataSetNotifyEvent;
    OldBeforeDelete :TDataSetNotifyEvent;
    OldMasterAfterScroll :TDataSetNotifyEvent;
    function FindVirtualRecord(Bookmark:TBookmark):Integer; virtual;
    function GetMasterDataSet(APropInfo:PPropInfo): TDataSet;
    function GetOwner: TPersistent; override;
    procedure DataSetAfterCancel(DataSet: TDataSet);
    procedure DataSetAfterClose(DataSet: TDataSet);
    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 DoSumListChanged;
    procedure Loaded;
    procedure MasterDataSetAfterScroll(DataSet: TDataSet);
    procedure ResetMasterInfo;
    procedure ReturnEvents; virtual;
    procedure SetActive(const Value: Boolean);
    procedure SetDataSet(Value:TDataSet);
    procedure SetExternalRecalc(const Value: Boolean);
    procedure SetSumCollection(const Value: TDBSumCollection);
    procedure Update;
  public
    constructor Create(AOwner:TComponent);
    destructor Destroy; override;
    function IsSequenced: Boolean;
    function RecordCount : Integer;
    procedure Activate(ARecalcAll: Boolean);
    procedure Assign(Source: TPersistent); override;
    procedure ClearSumValues; virtual;
    procedure Deactivate(AClearSumValues: Boolean);
    procedure RecalcAll; virtual;
    procedure SetDataSetEvents; virtual;
    property Active: Boolean read FActive write SetActive default True;
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property ExternalRecalc: Boolean read FExternalRecalc write SetExternalRecalc;
    property RecNo : Integer read GetRecNo write SetRecNo;
    property SumCollection:TDBSumCollection read FSumCollection write SetSumCollection;
    property VirtualRecords: Boolean read FVirtualRecords write SetVirtualRecords;
    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 GetRecNo: Integer;
    function GetSumCollection: TDBSumCollection;
    function GetSumListChanged: TNotifyEvent;
    function GetVirtualRecords: Boolean;
    procedure SetOnRecalcAll(const Value: TNotifyEvent);
    procedure SetRecNo(const Value: Integer);
    procedure SetSumListChanged(const Value: TNotifyEvent);
    procedure SetVirtualRecords(const Value: Boolean);
  protected
    FSumListProducer: TDBSumListProducer;
    procedure DataSetAfterClose(DataSet: TDataSet);
    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 DoSumListChanged;
    procedure Loaded; override;
    procedure MasterDataSetAfterScroll(DataSet: TDataSet);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetActive(const Value: Boolean);
    procedure SetDataSet(Value:TDataSet);
    procedure SetExternalRecalc(const Value: Boolean);
    procedure SetSumCollection(const Value: TDBSumCollection);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IsSequenced: Boolean;
    function RecordCount: Integer;
    procedure Activate(ARecalcAll: Boolean);
    procedure ClearSumValues; virtual;
    procedure Deactivate(AClearSumValues: Boolean);
    procedure RecalcAll; virtual;
    procedure SetDataSetEvents;
    property RecNo : Integer read GetRecNo write SetRecNo;
  published
    property Active: Boolean read GetActive write SetActive default True;
    property DataSet: TDataSet read GetDataSet write SetDataSet;
    property ExternalRecalc: Boolean read GetExternalRecalc write SetExternalRecalc;
    property SumCollection:TDBSumCollection read GetSumCollection write SetSumCollection;
    property VirtualRecords: Boolean read GetVirtualRecords write SetVirtualRecords;
    property SumListChanged: TNotifyEvent read GetSumListChanged write SetSumListChanged;
    property OnRecalcAll: TNotifyEvent read GetOnRecalcAll write SetOnRecalcAll;
  end;

implementation

{ TDBSumListProducer }

constructor TDBSumListProducer.Create(AOwner:TComponent);
{$ifdef eval}
  {$INCLUDE eval}
{$else}
begin
{$endif}
  inherited Create;
  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 // Set new events
  begin

    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;

    FMasterPropInfo := nil;
    FMasterDataSet := nil;

    FEventsOverloaded := False;
    for i := 0 to FVirtualRecList.Count-1
      do FDataSet.FreeBookmark(FVirtualRecList[i]);
    FVirtualRecList.Clear;
  end;
end;

procedure TDBSumListProducer.SetDataSet(Value: TDataSet);
var OldActive:Boolean;
begin
  if Assigned(Value) and (FDataSet = Value) and (csDestroying in Value.ComponentState) then
  begin
    ReturnEvents;
    FDataSet := nil;
  end;
  if (FDataSet = Value) then Exit;
  if not (csLoading in FOwner.ComponentState) and
      (FDesignTimeWork or not (csDesigning in FOwner.ComponentState)) then
  begin
    OldActive := Active;
    Deactivate(True);
    FDataSet := Value;
    if OldActive then Activate(True);
  end else
    FDataSet := Value;
end;

procedure TDBSumListProducer.Loaded;
begin
//  inherited;