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.
|
Пример создания компонента TDBNavigationButton