tntjvdbreccountlabel.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

Modified from the Original Code from: JvDBCtrl.PAS,
by Jordi March i Nogué ([e-mail])
 03/01/2006 version

You'll may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

-----------------------------------------------------------------------------}
// $Id: JvDBControls.pas,v 1.90 2005/08/20 23:04:08 remkobonte Exp $

unit TntJvDBRecCountLabel;

interface

{$D-}

uses
  Windows, Messages, SysUtils, Classes, Controls, StdCtrls, {JvExControls,}
  {JvComponent,} {JvLabel,} TntJvExStdCtrls, JvDBControls, Db, TntControls;

type
  TTntDBRecCountLabel = class({TJvCustomLabel}TTntJvExCustomLabel)
  private
    FCalcCount: Boolean;
    FOnGetRecNo: TDataValueEvent;
    FOnGetRecordCount: TDataValueEvent;
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    procedure SetCalcCount(Value: Boolean);
  protected
    FDataLink: TDataLink;
    FRecordCount: Longint;
    FRecordNo: Longint;
    procedure Loaded; override;
    function GetLabelCaption: string;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetName(const Value: TComponentName); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateData; virtual;
    procedure UpdateStatus; virtual;
    property Caption;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property CalcRecCount: Boolean read FCalcCount write SetCalcCount default False;
    property Layout default tlCenter;
    property Align;
    property Alignment;
    property AutoSize;
    property Color;
    property DragCursor;
    property DragMode;
    property Font;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Transparent;
    property Visible;
    property OnGetRecordCount: TDataValueEvent read FOnGetRecordCount write FOnGetRecordCount;
    property OnGetRecNo: TDataValueEvent read FOnGetRecNo write FOnGetRecNo;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnStartDrag;
    property OnContextPopup;
    property OnEndDock;
    property OnStartDock;
  end;

implementation

{--------------------------------------}

{ TStatusDataLinkNew }

type
  TStatusDataLinkNew = class(TDataLink)
  private
    FLabel: TTntDBRecCountLabel;
  protected
    procedure ActiveChanged; override;
    procedure EditingChanged; override;
    procedure DataSetChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
    procedure LayoutChanged; override;
  public
    constructor Create(ALabel: TTntDBRecCountLabel);
    destructor Destroy; override;
  end;

constructor TStatusDataLinkNew.Create(ALabel: TTntDBRecCountLabel);
begin
  inherited Create;
  FLabel := ALabel;
end;

destructor TStatusDataLinkNew.Destroy;
begin
  FLabel := nil;
  inherited Destroy;
end;

procedure TStatusDataLinkNew.ActiveChanged;
begin
  DataSetChanged;
end;

procedure TStatusDataLinkNew.DataSetScrolled(Distance: Integer);
begin
  if FLabel <> nil then FLabel.UpdateStatus;
end;

procedure TStatusDataLinkNew.EditingChanged;
begin
  if FLabel <> nil then FLabel.UpdateStatus;
end;

procedure TStatusDataLinkNew.DataSetChanged;
begin
  if FLabel <> nil then FLabel.UpdateData;
end;

procedure TStatusDataLinkNew.LayoutChanged;
begin
  if FLabel <> nil then DataSetChanged; { ??? }
end;

{ TTntDBRecCountLabel }

constructor TTntDBRecCountLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Layout := tlCenter;
  ControlStyle := ControlStyle - [csSetCaption , csReplicatable];
  FRecordCount := -1;
  FRecordNo := -1;
  ShowAccelChar := False;
  FDataLink := TStatusDataLinkNew.Create(Self);
end;

destructor TTntDBRecCountLabel.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TTntDBRecCountLabel.Loaded;
begin
  inherited Loaded;
  UpdateData;
end;

function TTntDBRecCountLabel.GetLabelCaption: string;
begin
  if (csDesigning in ComponentState) and ((FDatalink = nil) or not FDatalink.Active) then
    Result := Format('(%s)', [Name])
  else if ((FDatalink = nil) or (DataSource = nil)) then
    Result := ''
  else begin
    if FDataLink.Active then begin
      if FRecordNo >= 0 then begin
        if FRecordCount >= 0 then
          Result := Format('%d:%d', [FRecordNo, FRecordCount])
        else Result := IntToStr(FRecordNo);
      end
      else begin
        if FRecordCount >= 0 then
          Result := Format('( %d )', [FRecordCount])
        else Result := '';
      end;
    end
    else Result := '';
  end;
end;

procedure TTntDBRecCountLabel.SetName(const Value: TComponentName);
begin
  inherited SetName(Value);
  if (csDesigning in ComponentState) then Text := Format('(%s)', [Name]);
end;

procedure TTntDBRecCountLabel.UpdateData;

  function IsSequenced: Boolean;
  begin
    Result := FDataLink.DataSet.IsSequenced;
  end;

begin
  FRecordCount := -1;
  if FDataLink.Active and
    (DataSource.State in [dsBrowse, dsEdit]) then
  begin
    if Assigned(FOnGetRecordCount) then
      FOnGetRecordCount(Self, FDataLink.DataSet, FRecordCount)
    else if (FCalcCount or IsSequenced) then
      FRecordCount := FDataLink.DataSet.RecordCount;
  end;
  UpdateStatus;
end;

procedure TTntDBRecCountLabel.UpdateStatus;
begin
  if DataSource <> nil then begin
    FRecordNo := -1;
    if FDataLink.Active then begin
      if Assigned(FOnGetRecNo) then
        FOnGetRecNo(Self, FDataLink.DataSet, FRecordNo) else
      try
        with FDatalink.DataSet do
          if not IsEmpty then FRecordNo := RecNo;
      except
      end;
    end;
  end;
  //NeedsResize := True;
  Caption := GetLabelCaption; {New here}
  AdjustBounds;
  Invalidate;
end;

procedure TTntDBRecCountLabel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;
end;

function TTntDBRecCountLabel.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TTntDBRecCountLabel.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
  if not (csLoading in ComponentState) then
    UpdateData;
end;

procedure TTntDBRecCountLabel.SetCalcCount(Value: Boolean);
begin
  if FCalcCount <> Value then begin
    FCalcCount := Value;
    UpdateData;
  end;
end;

{--------------------------------------}

end.