Пример создания компонента TDBNavigationButton

unit NavBtn;

{ TDBNavigationButton: a data-aware TBitBtn
  Delphi 1 + 2

 The Beast
 E-Mail: thebeast_first_666@yahoo.com
 ICQ: 67756646
}

interface

uses
  WinTypes, WinProcs, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Messages, StdCtrls, Buttons, dbconsts, DB, DBTables;

type

  TNavigationButtonDataLink = class;

  TDBNavigationButtonType = (
    nbCustom,
    nbFirst, nbPrior, nbNext, nbLast,
    nbInsert, nbDelete,
    nbEdit,
    nbPost, nbCancel,
    nbRefresh);

  TBeforeActionEvent =
    procedure (Sender: TObject; var ActionIsDone: Boolean) of object;

  TDbNBDisableReason = (
    drBOF, drEOF, drReadonly,
    drNotEditing, drEditing, drEmpty);
  TDbNBDisableReasons = set of TDbNBDisableReason;


{ TDBNavigationButton }

  TDBNavigationButton = class (TBitBtn)
  private
    FDisableReasons: TDbNBDisableReasons;
    FDataLink: TNavigationButtonDataLink;
    FConfirmDelete: Boolean;
    FButtonEnabled: Boolean;
    FDBNavigationButtonType: TDBNavigationButtonType;
    FOnBeforeAction: TBeforeActionEvent;
    FOldOnGlyphChanged: TNotifyEvent;
    FCustomGlyph: Boolean;
    function GetDataSource: TDataSource;
    procedure SetDataSource(Value: TDataSource);
    procedure SetDBNavigationButtonType(Value: TDBNavigationButtonType);
    procedure ReadButtonEnabled(Reader: TReader);
    procedure WriteButtonEnabled(Writer: TWriter);
    function NumberOfStandardComponentName: Integer;
    function HasStandardComponentName: Boolean;
    procedure LoadGlyph;
    function StoreGlyph: Boolean;
    procedure GlyphChanged(Sender: TObject);
    procedure UpdateEnabled;
    procedure CalcDisableReasons;
  protected
    procedure DataChanged;
    procedure EditingChanged;
    procedure ActiveChanged;
    procedure Loaded; override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure CMEnabledChanged(var Message: TMessage);
      message CM_ENABLEDCHANGED;
    procedure Click; override;
    procedure DoAction; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ConfirmDelete: Boolean
      read FConfirmDelete write FConfirmDelete default True;
    property DataButtonType: TDBNavigationButtonType
      read FDBNavigationButtonType write SetDBNavigationButtonType;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property Glyph stored StoreGlyph;

{   Use BeforeAction instead of the Click-event if you want to cancel
    the default-action by setting ActionIsDone to true.
    The Click-event is called before the DoAction-event. }
    property OnBeforeAction: TBeforeActionEvent
      read FOnBeforeAction write FOnBeforeAction;

{   Use DisableReasons to say on what case the button has to be disabled.
    It is set automatic if you set DataButtonType <> nbCustom.
    DisableReason  | Disable if Dataset is...
    ---------------+-------------------------
      drBOF        | EOF
      drEOF        | BOF
      drReadonly   | Readonly
      drNotEditing | Not in insert or edit-mode
      drEditing    | In insert or edit-mode
      drEmpty      | Both BOF and EOF }
    property DisableReasons: TDbNBDisableReasons
      read FDisableReasons write FDisableReasons;
  end;


{ TNavigationButtonDataLink }

  TNavigationButtonDataLink = class(TDataLink)
  private
    FDBNavigationButton: TDBNavigationButton;
  protected
    procedure EditingChanged; override;
    procedure DataSetChanged; override;
    procedure ActiveChanged; override;
  public
    constructor Create(aDBNavigationButton: TDBNavigationButton);
    destructor Destroy; override;
  end;



procedure Register;

implementation

{ $R DBCTRLS} { uses DBCTRLS.RES, but that is already linked by DB.PAS }


const
{ RegisterPanel = 'Datensteuerung'; { german }
  RegisterPanel = 'Data Controls';

const
  CtrlNamePrefix = 'dbNavBtn';
  StandardComponentName = 'DBNavigationButton';

const
  BtnTypeName: array[TDBNavigationButtonType] of PChar =
    ('', 'FIRST', 'PRIOR', 'NEXT', 'LAST', 'INSERT', 'DELETE',
     'EDIT', 'POST', 'CANCEL', 'REFRESH');
  BtnName: array[TDBNavigationButtonType] of string =
    ('', 'First', 'Prior', 'Next', 'Last', 'New', 'Delete',
     'Edit', 'Save', 'Cancel', 'Refresh');


{ TNavigationButtonDataLink }

constructor TNavigationButtonDataLink.Create(aDBNavigationButton: TDBNavigationButton);
begin
  inherited Create;
  FDBNavigationButton := aDBNavigationButton;
end;

destructor TNavigationButtonDataLink.Destroy;
begin
  FDBNavigationButton := nil;
  inherited Destroy;
end;

procedure TNavigationButtonDataLink.EditingChanged;
begin
  if FDBNavigationButton <> nil then FDBNavigationButton.EditingChanged;
end;

procedure TNavigationButtonDataLink.DataSetChanged;
begin
  if FDBNavigationButton <> nil then FDBNavigationButton.DataChanged;
end;

procedure TNavigationButtonDataLink.ActiveChanged;
begin
  if FDBNavigationButton <> nil then FDBNavigationButton.ActiveChanged;
end;



{ TDBNavigationButton }

constructor TDBNavigationButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataLink := TNavigationButtonDataLink.Create(Self);
  DataButtonType := nbCustom;
  FConfirmDelete := True;
  FButtonEnabled := True;
  FCustomGlyph := false;
  FOldOnGlyphChanged := Glyph.OnChange;
  Glyph.OnChange := GlyphChanged;
  FDisableReasons := [];
end;

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

procedure TDBNavigationButton.GlyphChanged(Sender: TObject);
begin
  FCustomGlyph := true;
  if Assigned(FOldOnGlyphChanged) then FOldOnGlyphChanged(Sender);
end;

function TDBNavigationButton.StoreGlyph: Boolean;
begin { store only user-defined glyph: }
  result := (FDBNavigationButtonType = nbCustom) or FCustomGlyph;
end;

procedure TDBNavigationButton.LoadGlyph;
var
{$IFNDEF WIN32}
  Buffer: array[0..79] of Char;
{$ENDIF NDEF WIN32}
  ResName: string;
begin
  if (FDBNavigationButtonType = nbCustom) then
    exit;
  try
  { Load the Bitmap that DBNavigator would load: }
    FmtStr(ResName, 'dbn_%s', [BtnTypeName[FDBNavigationButtonType]]);
  {$IFDEF WIN32}
    Glyph.Handle := LoadBitmap(HInstance, PChar(ResName));
  {$ELSE DEF WIN32}
  { Glyph.Assign(nil); { clear }
    Glyph.Handle := LoadBitmap(HInstance, StrPCopy(Buffer, ResName));
  {$ENDIF DEF WIN32}
    NumGlyphs := 2;
    FCustomGlyph := false;
  except
  { error: do nothing }
  end;
end;

procedure TDBNavigationButton.CalcDisableReasons;
begin
  case FDBNavigationButtonType of
    nbPrior: FDisableReasons := [drBOF, drEditing, drEmpty];
    nbNext: FDisableReasons := [drEOF, drEditing, drEmpty];
    nbFirst: FDisableReasons := [drBOF, drEditing, drEmpty];
    nbLast: FDisableReasons := [drEOF, drEditing, drEmpty];
    nbInsert: FDisableReasons := [drReadonly, drEditing];
    nbEdit: FDisableReasons := [drReadonly, drEditing, drEmpty];
    nbCancel: FDisableReasons := [drNotEditing];
    nbPost: FDisableReasons := [drNotEditing];
    nbRefresh: FDisableReasons := [drEditing];
    nbDelete: FDisableReasons := [drReadonly, drEditing, drEmpty];
  end;
end;

function TDBNavigationButton.NumberOfStandardComponentName: Integer;
function NumberOfName(const TestName: String): Integer;
begin
  if (Length(Name) > Length(TestName)) and
     (Copy(Name, 1, Length(TestName)) = TestName) then
  begin
    try
      result := StrToInt(Copy(Name, Length(TestName) + 1, 255));
    except
      result := 0;
    end;
  end
  else
    result := 0;
end; { function NumberOfName }
begin { TDBNavigationButton.NumberOfStandardComponentName }
  result := NumberOfName(StandardComponentName);
  if (result = 0) then
    result := NumberOfName(CtrlNamePrefix + BtnName[FDBNavigationButtonType]);
end;

function TDBNavigationButton.HasStandardComponentName: Boolean;
function HasName(const TestName: String): Boolean;
begin
  if (Length(Name) > Length(TestName)) and
     (Copy(Name, 1, Length(TestName)) = TestName) then
  begin
    try
      result := (StrToInt(Copy(Name, Length(TestName) + 1, 255)) > 0);
    except
      result := false;
    end;
  end
  else
    result := (Name = TestName);
end; { function HasName }
begin
  result :=
    HasName(StandardComponentName) or
    HasName(CtrlNamePrefix + BtnName[FDBNavigationButtonType]);
end;

procedure TDBNavigationButton.SetDBNavigationButtonType(
  Value: TDBNavigationButtonType);
const
  TooMuch_SomethingIsWrong = 33;
var
  NewName: string;
  Number: Integer;
begin
  if (Value = FDBNavigationButtonType) then
    exit;
  if (csLoading in ComponentState) then
  begin
    FDBNavigationButtonType := Value;
    CalcDisableReasons;
    exit;
  end;
  Enabled := True;
  Spacing := -1;
  if (Value = nbCustom) then
    FCustomGlyph := true
  else
    if (FDBNavigationButtonType = nbCustom) or
       (Caption = BtnName[FDBNavigationButtonType]) then
    { Change caption if it was created automatically: }
      Caption := BtnName[Value];
  try { ... to change the name of the component: }
    if (csDesigning in ComponentState) and
       HasStandardComponentName then
    begin
      if (Value = nbCustom) then
        NewName := StandardComponentName
      else
        NewName := CtrlNamePrefix + BtnName[Value];
      if (Owner <> nil) and (Owner.FindComponent(NewName) <> nil) then
      begin
        Number := NumberOfStandardComponentName;
        if (Number = 0) then
          Number := 1;
        repeat
          if (Value = nbCustom) then
            NewName := StandardComponentName + IntToStr(Number)
          else
            NewName := CtrlNamePrefix + BtnName[Value] + IntToStr(Number);
          Inc(Number);
        until (Owner.FindComponent(NewName) = nil) or
              (Number = TooMuch_SomethingIsWrong);
      end;
      Name := NewName;
    end;
  except
  { don't change name if error occured }
  end;
  Enabled := False;
  Enabled := True;
  FDBNavigationButtonType := Value;
  LoadGlyph;
  CalcDisableReasons;
end;

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

procedure TDBNavigationButton.DoAction;
var
  Cancel: Boolean;
begin
  if (not (csDesigning in ComponentState)) and
     Assigned(FOnBeforeAction) then
  begin
    Cancel := (FDBNavigationButtonType = nbCustom);
    FOnBeforeAction(self, Cancel);
    if Cancel then
      exit;
  end;
  if (DataSource <> nil) and (DataSource.State <> dsInactive) then
  begin
    with DataSource.DataSet do
    begin
      case FDBNavigationButtonType of
        nbPrior: Prior;
        nbNext: Next;
        nbFirst: First;
        nbLast: Last;
        nbInsert: Insert;
        nbEdit: Edit;
        nbCancel: Cancel;
        nbPost: Post;
        nbRefresh: Refresh;
        nbDelete:
          {if not FConfirmDelete or
            (MessageDlg(LoadStr(SDeleteRecordQuestion), mtConfirmation,
            mbOKCancel, 0) <> idCancel) then Delete;}
      end;
    end;
  end;
end;

procedure TDBNavigationButton.Click;
begin
  inherited Click;
  DoAction;
end;

procedure TDBNavigationButton.UpdateEnabled;
var
  PossibleDisableReasons: TDbNBDisableReasons;
begin
  if (csDesigning in ComponentState) then
    exit;
  if (csDestroying in ComponentState) then
    exit;
  if not FButtonEnabled then
    exit;
  if FDataLink.Active then
  begin
    PossibleDisableReasons := [];
    if FDataLink.DataSet.BOF then
      Include(PossibleDisableReasons, drBOF);
    if FDataLink.DataSet.EOF then
      Include(PossibleDisableReasons, drEOF);
    if not FDataLink.DataSet.CanModify then
      Include(PossibleDisableReasons, drReadonly);
    if FDataLink.DataSet.BOF and FDataLink.DataSet.EOF then
      Include(PossibleDisableReasons, drEmpty);
    if FDataLink.Editing then
      Include(PossibleDisableReasons, drEditing)
    else
      Include(PossibleDisableReasons, drNotEditing);
  end
  else
    PossibleDisableReasons := [drBOF, drEOF, drReadonly, drNotEditing, drEmpty];
  Enabled := (FDisableReasons * PossibleDisableReasons = []);
  FButtonEnabled := true;
end;

procedure TDBNavigationButton.DataChanged;
begin
  UpdateEnabled;
end;

procedure TDBNavigationButton.EditingChanged;
begin
  UpdateEnabled;
end;

procedure TDBNavigationButton.ActiveChanged;
begin
  if not (csDesigning in ComponentState) then
  begin
    UpdateEnabled; { DataChanged; EditingChanged; }
  end;
end;

procedure TDBNavigationButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if (not (csLoading in ComponentState)) and
     (not (csDestroying in ComponentState)) then
  begin
    FButtonEnabled := Enabled;
    ActiveChanged;
  end;
end;

procedure TDBNavigationButton.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if not (csLoading in ComponentState) then
    ActiveChanged;
{$IFDEF WIN32}
  if Value <> nil then Value.FreeNotification(Self);
{$ENDIF DEF WIN32}
end;

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

procedure TDBNavigationButton.ReadButtonEnabled(Reader: TReader);
begin
  FButtonEnabled := Reader.ReadBoolean;
end;

procedure TDBNavigationButton.WriteButtonEnabled(Writer: TWriter);
begin
  Writer.WriteBoolean(FButtonEnabled);
end;

procedure TDBNavigationButton.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('RuntimeEnabled', ReadButtonEnabled, WriteButtonEnabled, true);
end;


procedure TDBNavigationButton.Loaded;
begin
  inherited Loaded;
  if Glyph.Empty then { no user-defined glyph: }
    LoadGlyph; { load standard glyph }
  Enabled := FButtonEnabled; {}
  ActiveChanged;
end;



procedure Register;
begin
  RegisterComponents(RegisterPanel, [TDBNavigationButton]);
end;

end.