sdbnavigator.pas

alpha db da sa pouzit na vsetky druhy coho len chcete

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

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

type
  TsNavButton = class;
  TsNavDataLink = class;
{$IFDEF D2006}
  TButtonSet = set of TNavigateBtn;
{$ENDIF}

  TsDBNavigator = class(TsPanel)
  private
    FDataLink: TsNavDataLink;
    FVisibleButtons: TButtonSet;
    FHints: TStrings;
    FDefHints: TStrings;
    MinBtnSize: TPoint;
    FOnNavClick: ENavClick;
    FBeforeAction: ENavClick;
    FocusedButton: TNavigateBtn;
    FConfirmDelete: Boolean;
    FFirstImageIndex: integer;
    FImages: TCustomImageList;
    FNumGlyphs: integer;
    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;
    procedure SetFirstImageIndex(const Value: integer);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetNumGlyphs(const Value: integer);
  protected
    procedure DataChanged;
    procedure EditingChanged;
    procedure ActiveChanged;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure CalcMinSize(var W, H: Integer);
    function MarginWidth : integer;
    property NumGlyphs : integer read FNumGlyphs Write SetNumGlyphs default 1;
  public
    Buttons: array[TNavigateBtn] of TsNavButton;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure WndProc (var Message: TMessage); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure BtnClick(Index: TNavigateBtn); virtual;
    procedure Loaded; override;
  published
    property Images : TCustomImageList read FImages write SetImages;
    property FirstImageIndex : integer read FFirstImageIndex write SetFirstImageIndex default 0;
    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, sMessages, sSkinProps, sDialogs;

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?';

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 Btn.Glyph.Assign(SDBN_FIRST)
  else if TypeName = 'PRIOR' then Btn.Glyph.Assign(SDBN_PRIOR)
  else if TypeName = 'NEXT' then Btn.Glyph.Assign(SDBN_NEXT)
  else if TypeName = 'LAST' then Btn.Glyph.Assign(SDBN_LAST)
  else if TypeName = 'INSERT' then Btn.Glyph.Assign(SDBN_INSERT)
  else if TypeName = 'DELETE' then Btn.Glyph.Assign(SDBN_DELETE)
  else if TypeName = 'EDIT' then Btn.Glyph.Assign(SDBN_EDIT)
  else if TypeName = 'POST' then Btn.Glyph.Assign(SDBN_POST)
  else if TypeName = 'CANCEL' then Btn.Glyph.Assign(SDBN_CANCEL)
  else if TypeName = 'REFRESH' then Btn.Glyph.Assign(SDBN_REFRESH);
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 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 (sMessageDlg(SDeleteRecordQuestion, mtConfirmation, mbOKCancel, 0) <> idCancel) then Delete;
    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);
  SkinData.COC := COC_TsToolBar;
  ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csOpaque];
  FDataLink := TsNavDataLink.Create(Self);
  FVisibleButtons := [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
  FHints := TStringList.Create;
  TStringList(FHints).OnChange := HintsChanged;
  InitButtons;
  InitHints;
  Width := 240;
  Height := 25;
  FocusedButton := nbFirst;
  FConfirmDelete := True;
  FullRepaint := False;
  FNumGlyphs := 1;
  FFirstImageIndex := 0;
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
  if Assigned(FDataLink) and Assigned(FDataLink.DataSource) then Result := FDataLink.DataSource else Result := nil;
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.Flat := True;
    Btn.Index := I;
    Btn.Visible := I in FVisibleButtons;
    Btn.Enabled := True;
    Btn.SetBounds (X, MarginWidth, MinBtnSize.X, Height - 2 * MarginWidth);
    LoadGlyph(Btn, BtnTypeName[I]);
    Btn.Glyph.PixelFormat := pf24bit;
    Btn.OnClick := ClickHandler;
    Btn.OnMouseDown := BtnMouseDown;
    Btn.Parent := Self;
    Buttons[I] := Btn;
    X := X + MinBtnSize.X;
  end;
  Buttons[nbPrior].NavStyle := Buttons[nbPrior].NavStyle + [nsAllowTimer];
  Buttons[nbNext].NavStyle  := Buttons[nbNext].NavStyle + [nsAllowTimer];
end;

procedure TsDBNavigator.InitHints;
var
  I: Integer;
  J: TNavigateBtn;
begin
  if not Assigned(FDefHints) then begin
    FDefHints := TStringList.Create;
    for J := Low(Buttons) to High(Buttons) do FDefHints.Add(LoadResString(BtnHintId[J]));
  end;
  for J := Low(Buttons) to High(Buttons) do Buttons[J].Hint := FDefHints[Ord(J)];
  J := Low(Buttons);
  for I := 0 to (FHints.Count - 1) do begin
    if FHints.Strings[I] <> '' then Buttons[J].Hint := FHints.Strings[I];
    if J = High(Buttons) then Exit;