⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ddhdbst.pas

📁 Delphi高级开发指南是开发程序的好帮手
💻 PAS
字号:
unit DdhDbSt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Db, CommCtrl, DbTables;

type
  TGetStringEvent = procedure (Sender: TObject;
    var Text: string) of object;

  TDdhStatusLink = class;

  TDdhDbStatusBar = class (TStatusBar)
  private
    FDataLink: TDdhStatusLink;
    function GetDataSource: TDataSource;
    procedure SetDataSource (Value: TDataSource);
    function GetSummary: TGetStringEvent;
    procedure SetSummary (Value: TGetStringEvent);
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property DataSource: TDataSource
      read GetDataSource write SetDataSource;
    property OnSummary: TGetStringEvent
      read GetSummary write SetSummary;
  end;

  TDdhStatusLink = class (TDataLink)
  private
    FBar: TDdhDbStatusBar;
    FOnSummary: TGetStringEvent;
  public
    constructor Create (Bar: TDdhDbStatusBar);
    procedure ActiveChanged; override;
    procedure EditingChanged; override;
    procedure RecordChanged (Field: TField); override;
    function RecordSummary: String;
    property OnSummary: TGetStringEvent
      read FOnSummary write FOnSummary;
  end;

procedure Register;

implementation

////// data link //////

constructor TDdhStatusLink.Create (Bar: TDdhDbStatusBar);
begin
  inherited Create;
  FBar := Bar;
end;

procedure TDdhStatusLink.ActiveChanged;
begin
  if Active then
  begin
    if DataSet is TTable then
      FBar.Panels[0].Text := TTable(DataSet).TableName
    else if DataSet is TQuery then
      FBar.Panels[0].Text := TQuery (DataSet).SQL.Text
    else
      FBar.Panels[0].Text := DataSet.Name;
    FBar.Panels[1].Text := '[Browsing]';
    FBar.Panels [2].Text := RecordSummary;
  end
  else
  begin
    FBar.Panels[0].Text := '[Inactive]';
    FBar.Panels[1].Text := '[]';
  end;
end;

procedure TDdhStatusLink.EditingChanged;
begin
  if Editing then
    FBar.Panels[1].Text := '[Editing]'
  else
    FBar.Panels[1].Text := '[Browsing]';
end;

procedure TDdhStatusLink.RecordChanged (Field: TField);
begin
  FBar.Panels [2].Text := RecordSummary;
end;

function TDdhStatusLink.RecordSummary;
var
  I: Integer;
  Summary: string;
begin
  // add record count
  Summary := Format ('(Rec %d/%d)',
    [DataSet.RecNo, DataSet.RecordCount]);
  // add custom description of default one
  if Assigned (FOnSummary) then
    FOnSummary (FBar, Summary)
  else
  begin
    Summary := Summary + ' - ';
    for I := 0 to DataSet.FieldCount - 1 do
      Summary := Summary +
        DataSet.Fields[I].DisplayText + ' ';
  end;
  Result := Summary;
end;

////// component //////

constructor TDdhDbStatusBar.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  FDataLink := TDdhStatusLink.Create (self);
  // status bar
  if csDesigning in ComponentState then
  begin
    // create three panels and initialize them
    Panels.Add.Text := '[Inactive]';
    Panels.Add.Text := '[]';
    Panels.Add.Text := 'Record';
  end;
end;

procedure TDdhDbStatusBar.Loaded;
begin
  inherited;
  if not (csDesigning in ComponentState) and
      (Panels.Count < 3) then
    raise Exception.Create (
      'DdhDbStatusBar must have at least 3 panels');
end;

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

// data-aware support
function TDdhDbStatusBar.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TDdhDbStatusBar.SetDataSource (Value: TDataSource);
begin
  FDataLink.DataSource := Value;
end;

function TDdhDbStatusBar.GetSummary: TGetStringEvent;
begin
  Result := FDataLink.OnSummary;
end;

procedure TDdhDbStatusBar.SetSummary (Value: TGetStringEvent);
begin
  FDataLink.OnSummary := Value;
end;

procedure Register;
begin
  RegisterComponents('DDHB DB', [TDdhDbStatusBar]);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -