sdbnavigator.pas

AlphaControls是一个Delphi标准控件的集合

unit sDBNavigator;
{$I sDefs.inc}
{$R SDBRES.RES}

interface
              
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, sPanel, dbctrls, sconst, sCustomButton, db, dbconsts, math;

type
  TsNavButton = class;
  TsNavDataLink = class;

  TsDBNavigator = class(TsPanel)
  private
    FDataLink: TsNavDataLink;
    FVisibleButtons: TButtonSet;
    FHints: TStrings;
    FDefHints: TStrings;
    MinBtnSize: TPoint;
    FOnNavClick: ENavClick;
    FBeforeAction: ENavClick;
    FocusedButton: TNavigateBtn;
    FConfirmDelete: Boolean;
    function ButtonWidth : integer;
    function ButtonsCount : integer;
    procedure BtnMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ClickHandler(Sender: TObject);
    function GetDataSource: TDataSource;
    function GetHints: TStrings;
    procedure HintsChanged(Sender: TObject);
    procedure InitButtons;
    procedure InitHints;
    procedure SetDataSource(Value: TDataSource);
    procedure SetHints(Value: TStrings);
    procedure SetSize(var W: Integer; var H: Integer);
    procedure SetVisible(Value: TButtonSet);
    procedure WMSize(var Message: TWMSize);  message WM_SIZE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  protected
    Buttons: array[TNavigateBtn] of TsNavButton;
    procedure DataChanged;
    procedure EditingChanged;
    procedure ActiveChanged;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure CalcMinSize(var W, H: Integer);
    function MarginWidth : integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure BtnClick(Index: TNavigateBtn); virtual;
    procedure Loaded; override;
  published
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property VisibleButtons: TButtonSet read FVisibleButtons write SetVisible
      default [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete,
        nbEdit, nbPost, nbCancel, nbRefresh];
    property Hints: TStrings read GetHints write SetHints;
    property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
    property BeforeAction: ENavClick read FBeforeAction write FBeforeAction;
    property OnClick: ENavClick read FOnNavClick write FOnNavClick;
    property Width default 240;
    property Height default 25;
  end;

{ TsNavButton }

  TsNavButton = class(TsSpeedButton)
  private
    FIndex: TNavigateBtn;
    FNavStyle: TNavButtonStyle;
    FRepeatTimer: TTimer;
    procedure TimerExpired(Sender: TObject);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    property NavStyle: TNavButtonStyle read FNavStyle write FNavStyle;
    procedure Paint; override;
    property Index : TNavigateBtn read FIndex write FIndex;
  end;

{ TsNavDataLink }

  TsNavDataLink = class(TDataLink)
  private
    FNavigator: TsDBNavigator;
  protected
    procedure EditingChanged; override;
    procedure DataSetChanged; override;
    procedure ActiveChanged; override;
  public
    constructor Create(ANav: TsDBNavigator);
    destructor Destroy; override;
  end;

implementation

uses sDefaults;

resourcestring
  SFirstRecord = 'First record';
  SPriorRecord = 'Prior record';
  SNextRecord = 'Next record';
  SLastRecord = 'Last record';
  SInsertRecord = 'Insert record';
  SDeleteRecord = 'Delete record';
  SEditRecord = 'Edit record';
  SPostEdit = 'Post edit';
  SCancelEdit = 'Cancel edit';
  SRefreshRecord = 'Refresh data';
  SDeleteRecordQuestion = 'Delete record?';
//  SDeleteMultipleRecordsQuestion = 'Delete all selected records?';
//  SRecordNotFound = 'Record not found';
//  SDataSourceFixed = 'Operation not allowed in a DBCtrlGrid';
//  SNotReplicatable = 'Control cannot be used in a DBCtrlGrid';
//  SPropDefByLookup = 'Property already defined by lookup field';
//  STooManyColumns = 'Grid requested to display more than 256 columns';

var
  BtnTypeName: array[TNavigateBtn] of PChar = ('FIRST', 'PRIOR', 'NEXT',
    'LAST', 'INSERT', 'DELETE', 'EDIT', 'POST', 'CANCEL', 'REFRESH');
  BtnHintId: array[TNavigateBtn] of Pointer = (@SFirstRecord, @SPriorRecord,
    @SNextRecord, @SLastRecord, @SInsertRecord, @SDeleteRecord, @SEditRecord,
    @SPostEdit, @SCancelEdit, @SRefreshRecord);

  SDBN_FIRST, SDBN_PRIOR, SDBN_NEXT, SDBN_LAST, SDBN_INSERT, SDBN_DELETE, SDBN_EDIT,
  SDBN_POST, SDBN_CANCEL, SDBN_REFRESH : TBitmap;

{ TsDBNavigator }

procedure LoadGlyph(Btn : TsNavButton; TypeName : string);
begin
  if TypeName = 'FIRST' then begin
    Btn.Glyph.Assign(SDBN_FIRST);
  end
  else if TypeName = 'PRIOR' then begin
    Btn.Glyph.Assign(SDBN_PRIOR);
  end
  else if TypeName = 'NEXT' then begin
    Btn.Glyph.Assign(SDBN_NEXT);
  end
  else if TypeName = 'LAST' then begin
    Btn.Glyph.Assign(SDBN_LAST);
  end
  else if TypeName = 'INSERT' then begin
    Btn.Glyph.Assign(SDBN_INSERT);
  end
  else if TypeName = 'DELETE' then begin
    Btn.Glyph.Assign(SDBN_DELETE);
  end
  else if TypeName = 'EDIT' then begin
    Btn.Glyph.Assign(SDBN_EDIT);
  end
  else if TypeName = 'POST' then begin
    Btn.Glyph.Assign(SDBN_POST);
  end
  else if TypeName = 'CANCEL' then begin
    Btn.Glyph.Assign(SDBN_CANCEL);
  end
  else if TypeName = 'REFRESH' then begin
    Btn.Glyph.Assign(SDBN_REFRESH);
  end;
end;

procedure TsDBNavigator.ActiveChanged;
var
  I: TNavigateBtn;
begin
  if not (Enabled and FDataLink.Active) then
    for I := Low(Buttons) to High(Buttons) do
      Buttons[I].Enabled := False
  else
  begin
    DataChanged;
    EditingChanged;
  end;
end;

procedure TsDBNavigator.BtnClick(Index: TNavigateBtn);
begin
  if (DataSource <> nil) and (DataSource.State <> dsInactive) then
  begin
    if not (csDesigning in ComponentState) and Assigned(FBeforeAction) then
      FBeforeAction(Self, Index);
    with DataSource.DataSet do
    begin
      case Index 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(SDeleteRecordQuestion, mtConfirmation,
            mbOKCancel, 0) <> idCancel) then Delete;
      end;
    end;
  end;
  if not (csDesigning in ComponentState) and Assigned(FOnNavClick) then
    FOnNavClick(Self, Index);
end;

procedure TsDBNavigator.BtnMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  OldFocus: TNavigateBtn;
begin
  OldFocus := FocusedButton;
  FocusedButton := TsNavButton (Sender).Index;
  if TabStop and (GetFocus <> Handle) and CanFocus then
  begin
    SetFocus;
    if (GetFocus <> Handle) then
      Exit;
  end
  else if TabStop and (GetFocus = Handle) and (OldFocus <> FocusedButton) then
  begin
    Buttons[OldFocus].Invalidate;
    Buttons[FocusedButton].Invalidate;
  end;
end;

function TsDBNavigator.ButtonsCount: integer;
var
  i : TNavigateBtn;
begin
  Result := 0;
  for I := Low(Buttons) to High(Buttons) do begin
    if Buttons[I].Visible then begin
      Inc(Result);
    end;
  end;
  if Result = 0 then Inc(Result);
end;

function TsDBNavigator.ButtonWidth: Integer;
begin
  ButtonWidth := (Width - 2 * MarginWidth) div ButtonsCount;
end;

procedure TsDBNavigator.CalcMinSize(var W, H: Integer);
begin
  if (csLoading in ComponentState) then Exit;
  if Buttons[nbFirst] = nil then Exit;

  W := Max(W, ButtonsCount * MinBtnSize.X + 2 * MarginWidth);
  H := Max(H, MinBtnSize.Y + 2 * MarginWidth);
end;

procedure TsDBNavigator.ClickHandler(Sender: TObject);
begin
  BtnClick(TsNavButton(Sender).Index);
end;

procedure TsDBNavigator.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  if not (csLoading in ComponentState) then
    ActiveChanged;
end;

constructor TsDBNavigator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption];// + [csOpaque];
//  if not NewStyleControls then ControlStyle := ControlStyle + [csFramed];
  FDataLink := TsNavDataLink.Create(Self);
  FVisibleButtons := [nbFirst, nbPrior, nbNext, nbLast, nbInsert,
    nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
  FHints := TStringList.Create;
  TStringList(FHints).OnChange := HintsChanged;
  InitButtons;
  InitHints;
  if (csDesigning in ComponentState) and (sStyle.Background.Gradient.Data = '') then begin
    sStyle.Background.Gradient.Data := GradientTsDBNavigator;
  end;
  Width := 240;
  Height := 25;
  FocusedButton := nbFirst;
  FConfirmDelete := True;
  FullRepaint := False;
end;

procedure TsDBNavigator.DataChanged;
var
  UpEnable, DnEnable: Boolean;
begin
  UpEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.BOF;
  DnEnable := Enabled and FDataLink.Active and not FDataLink.DataSet.EOF;
  Buttons[nbFirst].Enabled := UpEnable;
  Buttons[nbPrior].Enabled := UpEnable;
  Buttons[nbNext].Enabled := DnEnable;
  Buttons[nbLast].Enabled := DnEnable;
  Buttons[nbDelete].Enabled := Enabled and FDataLink.Active and
    FDataLink.DataSet.CanModify and
    not (FDataLink.DataSet.BOF and FDataLink.DataSet.EOF);
end;

destructor TsDBNavigator.Destroy;
begin
  FDefHints.Free;
  FDataLink.Free;
  FHints.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TsDBNavigator.EditingChanged;
var
  CanModify: Boolean;
begin
  CanModify := Enabled and FDataLink.Active and FDataLink.DataSet.CanModify;
  Buttons[nbInsert].Enabled := CanModify;
  Buttons[nbEdit].Enabled := CanModify and not FDataLink.Editing;
  Buttons[nbPost].Enabled := CanModify and FDataLink.Editing;
  Buttons[nbCancel].Enabled := CanModify and FDataLink.Editing;
  Buttons[nbRefresh].Enabled := CanModify;
end;

procedure TsDBNavigator.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;

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

function TsDBNavigator.GetHints: TStrings;
begin
  if (csDesigning in ComponentState) and not (csWriting in ComponentState) and
     not (csReading in ComponentState) and (FHints.Count = 0) then
    Result := FDefHints else
    Result := FHints;
end;

procedure TsDBNavigator.HintsChanged(Sender: TObject);
begin
  InitHints;
end;

procedure TsDBNavigator.InitButtons;
var
  I: TNavigateBtn;
  Btn: TsNavButton;
  X: Integer;
begin
  MinBtnSize := Point(6, 6);
  X := MarginWidth;
  for I := Low(Buttons) to High(Buttons) do begin
    Btn := TsNavButton.Create (Self);
    Btn.Index := I;
    Btn.Visible := I in FVisibleButtons;
    Btn.Enabled := True;