unit tbcprecordcountunit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
    Dialogs,
  StdCtrls, DbCtrls, Db;

type
  TBcpRecordDisplay = (rdCount, rdPos, rdCountPos, rdPosCount);

  TBcpRecordCount = class(TCustomLabel)
  private
    FLink : TDataLink;
    FRecordDisplay : TBcpRecordDisplay;
    FSeperator : string;
    FAllowFetchAll : Boolean;
    function GetDataSource : TDataSource;
    procedure SetDataSource(const Value : TDataSource);
    procedure SetRecordDisplay(const Value : TBcpRecordDisplay);
    procedure SetSeperator(const Value : string);
    procedure SetAllowFetchAll(const Value : Boolean);
    { Private declarations }
  protected
    { Protected declarations }
    procedure DoUpdate;
    procedure OnChanged(Sender : TObject);
  public
    { Public declarations }
    constructor Create(aOwner : TComponent); override;
    destructor Destroy; override;
  published
    property DataSource : TDataSource read GetDataSource write
      SetDataSource;
    property RecordDisplay : TBcpRecordDisplay read FRecordDisplay
      write SetRecordDisplay;
    property Seperator : string read FSeperator write SetSeperator;
    property AllowFetchAll : Boolean read FAllowFetchAll write
      SetAllowFetchAll;
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowAccelChar;
    property ShowHint;
    property Transparent;
    property Layout;
    property Visible;
    property WordWrap;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

type

  { TBcpDataLink }

  TBcpDataLink = class(TDataLink)
  private
    FOnChanged : TNotifyEvent;
    FRecordPos : integer;
    FMaxPos : integer;
    FFetchedAll : Boolean;
    procedure SetOnChanged(const Value : TNotifyEvent);
    function GetRecordPos : integer;
    function GetMaxPos : integer;
  protected
    procedure ActiveChanged; override;
    procedure RecordChanged(Field : TField); override;
    procedure LayoutChanged; override;
    procedure DataSetScrolled(Distance : integer); override;
    procedure FetchAll;
  public
    constructor Create; virtual;
    property RecordPos : integer read GetRecordPos;
    property MaxPos : integer read GetMaxPos;
    property FetchedAll : Boolean read FFetchedAll;
    property OnChanged : TNotifyEvent read FOnChanged write
      SetOnChanged;
  end;

  { TBcpRecordCount }

constructor TBcpRecordCount.Create(aOwner : TComponent);
begin
  inherited;
  FLink := TBcpDataLink.Create;
  TBcpDataLink(FLink).OnChanged := OnChanged;
  FRecordDisplay := rdCount;
  FSeperator := '/';
  FAllowFetchAll := True;
end;

destructor TBcpRecordCount.Destroy;
begin
  inherited;
  FLink.Free;
end;

procedure TBcpRecordCount.DoUpdate;
var
  Count, Pos : string;
begin
  if (FLink.Active) then
  begin
    { prepare helper strings }
    if (FRecordDisplay in [rdCount, rdCountPos, rdPosCount]) then
    begin
      if FAllowFetchAll then
      begin
        TBcpDataLink(FLink).FetchAll;
        Count := Format('%d', [FLink.RecordCount]);
      end
      else
      begin
        Count := Format('%d', [TBcpDataLink(FLink).MaxPos]);
        if not (TBcpDataLink(FLink).FetchedAll) then
          Count := Count + '+';
      end;
    end;
    if (FRecordDisplay in [rdPos, rdCountPos, rdPosCount]) then
      Pos := Format('%d', [TBcpDataLink(FLink).RecordPos]);
    { update the caption }
    case FRecordDisplay of
      rdCount : Caption := Count;
      rdPos : Caption := Pos;
      rdCountPos : Caption := Format('%s%s%s', [Count, FSeperator,
        Pos]);
      rdPosCount : Caption := Format('%s%s%s', [Pos, FSeperator,
        Count]);
    end;
  end
  else
    Caption := '...';
end;

function TBcpRecordCount.GetDataSource : TDataSource;
begin
  Result := FLink.DataSource;
end;

procedure TBcpRecordCount.OnChanged(Sender : TObject);
begin
  DoUpdate;
end;

procedure TBcpRecordCount.SetAllowFetchAll(const Value : Boolean);
begin
  FAllowFetchAll := Value;
  DoUpdate;
end;

procedure TBcpRecordCount.SetDataSource(const Value : TDataSource);
begin
  FLink.DataSource := Value;
  DoUpdate;
end;

procedure TBcpRecordCount.SetRecordDisplay(const Value :
  TBcpRecordDisplay);
begin
  FRecordDisplay := Value;
  DoUpdate;
end;

procedure TBcpRecordCount.SetSeperator(const Value : string);
begin
  FSeperator := Value;
  DoUpdate;
end;

{ TBcpDataLink }

procedure TBcpDataLink.ActiveChanged;
begin
  inherited;

  if not (Active) then
  begin
    FRecordPos := 1;
    FMaxPos := 1;
    FFetchedAll := False;
  end;

  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

constructor TBcpDataLink.Create;
begin
  inherited;
  FRecordPos := 1;
  FMaxPos := 1;
  FFetchedAll := False;
end;

procedure TBcpDataLink.DataSetScrolled(Distance : integer);
begin
  Inc(FRecordPos, Distance);

  if (FRecordPos > FMaxPos) then
    FMaxPos := FRecordPos;

  inherited;
end;

procedure TBcpDataLink.FetchAll;
var
  B : TBookmark;
begin
  if (Active) and (not FetchedAll) then
  begin
    FFetchedAll := True;
    B := DataSet.GetBookmark;
    DataSet.DisableControls;
    try
      DataSet.Last;
    finally
      DataSet.GotoBookmark(B);
      DataSet.FreeBookmark(B);
      DataSet.EnableControls;
    end;
  end;
end;

function TBcpDataLink.GetMaxPos : integer;
begin
  GetRecordPos; { update the recordpos and fmaxpos }
  Result := FMaxPos;
end;

function TBcpDataLink.GetRecordPos : integer;
begin
  if Bof then
    FRecordPos := 1
  else if Eof then
  begin
    FRecordPos := FMaxPos;
    FFetchedAll := True;
  end;
  Result := FRecordPos;
end;

procedure TBcpDataLink.LayoutChanged;
begin
  inherited;
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TBcpDataLink.RecordChanged;
begin
  inherited;
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

procedure TBcpDataLink.SetOnChanged(const Value : TNotifyEvent);
begin
  FOnChanged := Value;
end;

end.