Delphi World - Пример создания компонента TDBNavigationButton
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Пример создания компонента 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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования