以下代码可以在 D6_D2007 安装。
//支持换肤的导航条按钮
//zjx4051@gmail.com
unit DzNavigator;
{$R-,H+,X+}
interface
uses Variants, Windows, SysUtils, Messages, Controls, Forms, Classes,
Graphics, Menus, StdCtrls, ExtCtrls, Mask, Buttons, ComCtrls, DB;
const
InitRepeatPause = 400; { pause before repeat timer (ms) }
RepeatPause = 100; { pause before hint window displays (ms)}
SpaceSize = 5; { size of space between special buttons }
type
TNavbtnSkin=(Skin1,Skin2,Skin3,Skin4,Skin5,Skin6);
TNavButton = class;
TNavDataLink = class;
TNavGlyph = (ngEnabled, ngDisabled);
TNavigateBtn = (nbFirst, nbPrior, nbNext, nbLast,
nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh);
TNavButtonSet = set of TNavigateBtn;
TNavButtonStyle = set of (nsAllowTimer, nsFocusRect);
ENavClick = procedure (Sender: TObject; Button: TNavigateBtn) of object;
{ TDBNavigator }
TDZNavigator = class (TCustomPanel)
private
FDataLink: TNavDataLink;
FVisibleButtons: TNavButtonSet;
FHints: TStrings;
FDefHints: TStrings;
ButtonWidth: Integer;
MinBtnSize: TPoint;
FOnNavClick: ENavClick;
FBeforeAction: ENavClick;
FocusedButton: TNavigateBtn;
FConfirmDelete: Boolean;
FFlat: Boolean;
fNavbtnSkin: TNavbtnSkin;
procedure UpdateNavbtnSkin;
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 SetFlat(Value: Boolean);
procedure SetHints(Value: TStrings);
procedure SetSize(var W: Integer; var H: Integer);
procedure SetVisible(Value: TNavButtonSet);
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 SetNavbtnSkin(const Value: TNavbtnSkin);
protected
Buttons: array[TNavigateBtn] of TNavButton;
procedure DataChanged;
procedure EditingChanged;
procedure ActiveChanged;
procedure Loaded; override;
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);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure BtnClick(Index: TNavigateBtn); virtual;
published
property DataSource: TDataSource read GetDataSource write SetDataSource;
property VisibleButtons: TNavButtonSet read FVisibleButtons write SetVisible
default [nbFirst, nbPrior, nbNext, nbLast, nbInsert, nbDelete,
nbEdit, nbPost, nbCancel, nbRefresh];
property NavbtnSkin :TNavbtnSkin read fNavbtnSkin write SetNavbtnSkin default Skin1;
property Align;
property Anchors;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Flat: Boolean read FFlat write SetFlat default False;
property Ctl3D;
property Hints: TStrings read GetHints write SetHints;
property ParentCtl3D;
property ParentShowHint;
property PopupMenu;
property ConfirmDelete: Boolean read FConfirmDelete write FConfirmDelete default True;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property BeforeAction: ENavClick read FBeforeAction write FBeforeAction;
property OnClick: ENavClick read FOnNavClick write FOnNavClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnResize;
property OnStartDock;
property OnStartDrag;
end;
{ TNavButton }
TNavButton = class(TSpeedButton)
private
FIndex: TNavigateBtn;
FNavStyle: TNavButtonStyle;
FRepeatTimer: TTimer;
procedure TimerExpired(Sender: TObject);
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
destructor Destroy; override;
property NavStyle: TNavButtonStyle read FNavStyle write FNavStyle;
property Index : TNavigateBtn read FIndex write FIndex;
end;
{ TNavDataLink }
TNavDataLink = class(TDataLink)
private
FNavigator: TDZNavigator;
protected
procedure EditingChanged; override;
procedure DataSetChanged; override;
procedure ActiveChanged; override;
public
constructor Create(ANav: TDZNavigator);
destructor Destroy; override;
end;
procedure Register;
implementation
uses DBLogDlg, DBPWDlg, Clipbrd, DBConsts, Dialogs, Math, Themes, Types;
{$R dbctrlsdefault.res}
{$R DBCtrls32.res}
{$R DBCtrls48.res}
{ BiDiMode support routines }
resourcestring
{ DBCtrls }
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';
SConfirmCaption = 'Confirm';
SRefreshRecord = 'Refresh data';
SDeleteRecordQuestion = 'Delete record?';
SDeleteMultipleRecordsQuestion = 'Delete all selected records?';
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';
{ TDBNavigator }
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);
procedure Register;
begin
RegisterComponents('RollerSKF', [TDZNavigator]);
end;
constructor TDZNavigator.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] + [csOpaque];
if not NewStyleControls then ControlStyle := ControlStyle + [csFramed];
FDataLink := TNavDataLink.Create(Self);
FVisibleButtons := [nbFirst, nbPrior, nbNext, nbLast, nbInsert,
nbDelete, nbEdit, nbPost, nbCancel, nbRefresh];
FHints := TStringList.Create;
TStringList(FHints).OnChange := HintsChanged;
InitButtons;
InitHints;
BevelOuter := bvNone;
BevelInner := bvNone;
Width := 241;
Height := 25;
ButtonWidth := 0;
FocusedButton := nbFirst;
FConfirmDelete := True;
FullRepaint := False;
end;
destructor TDZNavigator.Destroy;
begin
FDefHints.Free;
FDataLink.Free;
FHints.Free;
FDataLink := nil;
inherited Destroy;
end;
procedure TDZNavigator.InitButtons;
var
I: TNavigateBtn;
Btn: TNavButton;
X: Integer;
ResName: string;
begin
MinBtnSize := Point(24, 24);
X := 0;
for I := Low(Buttons) to High(Buttons) do
begin
Btn := TNavButton.Create (Self);
Btn.Flat := Flat;
Btn.Index := I;
Btn.Visible := I in FVisibleButtons;
Btn.Enabled := True;
Btn.SetBounds (X, 0, MinBtnSize.X, MinBtnSize.Y);
case fNavbtnSkin of
Skin1: FmtStr(ResName, 'dbn_%s', [BtnTypeName[I]]);
Skin2: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
Skin3: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
Skin4: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
Skin5: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
Skin6: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
end;
Btn.Glyph.LoadFromResourceName(HInstance, ResName);
Btn.NumGlyphs := 2;
Btn.Enabled := False;
Btn.Enabled := True;
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 TDZNavigator.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;
Inc(J);
end;
end;
procedure TDZNavigator.HintsChanged(Sender: TObject);
begin
InitHints;
end;
procedure TDZNavigator.SetFlat(Value: Boolean);
var
I: TNavigateBtn;
begin
if FFlat <> Value then
begin
FFlat := Value;
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Flat := Value;
end;
end;
procedure TDZNavigator.SetHints(Value: TStrings);
begin
if Value.Text = FDefHints.Text then
FHints.Clear else
FHints.Assign(Value);
end;
procedure TDZNavigator.SetNavbtnSkin(const Value: TNavbtnSkin);
begin
if fNavbtnSkin <> Value then begin
fNavbtnSkin := Value;
UpdateNavbtnSkin;
end;
end;
function TDZNavigator.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 TDZNavigator.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
procedure TDZNavigator.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (FDataLink <> nil) and
(AComponent = DataSource) then DataSource := nil;
end;
procedure TDZNavigator.SetVisible(Value: TNavButtonSet);
var
I: TNavigateBtn;
W, H: Integer;
begin
W := Width;
H := Height;
FVisibleButtons := Value;
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Visible := I in FVisibleButtons;
SetSize(W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds (Left, Top, W, H);
Invalidate;
end;
procedure TDZNavigator.UpdateNavbtnSkin;
var
I: TNavigateBtn;
ResName: string;
begin
for I := Low(Buttons) to High(Buttons) do
begin
case fNavbtnSkin of
Skin1: FmtStr(ResName, 'dbn_%s', [BtnTypeName[I]]);
Skin2: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
Skin3: FmtStr(ResName, 'dbn2_%s', [BtnTypeName[I]]);
Skin4: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
Skin5: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
Skin6: FmtStr(ResName, 'dbn1_%s', [BtnTypeName[I]]);
end;
Buttons[I].Glyph.LoadFromResourceName(HInstance, ResName);
end;
end;
procedure TDZNavigator.CalcMinSize(var W, H: Integer);
var
Count: Integer;
I: TNavigateBtn;
begin
if (csLoading in ComponentState) then Exit;
if Buttons[nbFirst] = nil then Exit;
Count := 0;
for I := Low(Buttons) to High(Buttons) do
if Buttons[I].Visible then
Inc(Count);
if Count = 0 then Inc(Count);
W := Max(W, Count * MinBtnSize.X);
H := Max(H, MinBtnSize.Y);
if Align = alNone then W := (W div Count) * Count;
end;
procedure TDZNavigator.SetSize(var W: Integer; var H: Integer);
var
Count: Integer;
I: TNavigateBtn;
Space, Temp, Remain: Integer;
X: Integer;
begin
if (csLoading in ComponentState) then Exit;
if Buttons[nbFirst] = nil then Exit;
CalcMinSize(W, H);
Count := 0;
for I := Low(Buttons) to High(Buttons) do
if Buttons[I].Visible then
Inc(Count);
if Count = 0 then Inc(Count);
ButtonWidth := W div Count;
Temp := Count * ButtonWidth;
if Align = alNone then W := Temp;
X := 0;
Remain := W - Temp;
Temp := Count div 2;
for I := Low(Buttons) to High(Buttons) do
begin
if Buttons[I].Visible then
begin
Space := 0;
if Remain <> 0 then
begin
Dec(Temp, Remain);
if Temp < 0 then
begin
Inc(Temp, Count);
Space := 1;
end;
end;
Buttons[I].SetBounds(X, 0, ButtonWidth + Space, Height);
Inc(X, ButtonWidth + Space);
end
else
Buttons[I].SetBounds (Width + 1, 0, ButtonWidth, Height);
end;
end;
procedure TDZNavigator.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
W, H: Integer;
begin
W := AWidth;
H := AHeight;
if not HandleAllocated then SetSize(W, H);
inherited SetBounds (ALeft, ATop, W, H);
end;
procedure TDZNavigator.WMSize(var Message: TWMSize);
var
W, H: Integer;
begin
inherited;
W := Width;
H := Height;
SetSize(W, H);
end;
procedure TDZNavigator.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
inherited;
if (SWP_NOSIZE and Message.WindowPos.Flags) = 0 then
CalcMinSize(Message.WindowPos.cx, Message.WindowPos.cy);
end;
procedure TDZNavigator.ClickHandler(Sender: TObject);
begin
BtnClick (TNavButton (Sender).Index);
end;
procedure TDZNavigator.BtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
OldFocus: TNavigateBtn;
begin
OldFocus := FocusedButton;
FocusedButton := TNavButton (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;
procedure TDZNavigator.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 TDZNavigator.WMSetFocus(var Message: TWMSetFocus);
begin
Buttons[FocusedButton].Invalidate;
end;
procedure TDZNavigator.WMKillFocus(var Message: TWMKillFocus);
begin
Buttons[FocusedButton].Invalidate;
end;
procedure TDZNavigator.KeyDown(var Key: Word; Shift: TShiftState);
var
NewFocus: TNavigateBtn;
OldFocus: TNavigateBtn;
begin
OldFocus := FocusedButton;
case Key of
VK_RIGHT:
begin
if OldFocus < High(Buttons) then
begin
NewFocus := OldFocus;
repeat
NewFocus := Succ(NewFocus);
until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible);
if Buttons[NewFocus].Visible then
begin
FocusedButton := NewFocus;
Buttons[OldFocus].Invalidate;
Buttons[NewFocus].Invalidate;
end;
end;
end;
VK_LEFT:
begin
NewFocus := FocusedButton;
repeat
if NewFocus > Low(Buttons) then
NewFocus := Pred(NewFocus);
until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible);
if NewFocus <> FocusedButton then
begin
FocusedButton := NewFocus;
Buttons[OldFocus].Invalidate;
Buttons[FocusedButton].Invalidate;
end;
end;
VK_SPACE:
begin
if Buttons[FocusedButton].Enabled then
Buttons[FocusedButton].Click;
end;
end;
end;
procedure TDZNavigator.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
Message.Result := DLGC_WANTARROWS;
end;
procedure TDZNavigator.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;
procedure TDZNavigator.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 TDZNavigator.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 TDZNavigator.CMEnabledChanged(var Message: TMessage);
begin
inherited;
if not (csLoading in ComponentState) then
ActiveChanged;
end;
procedure TDZNavigator.SetDataSource(Value: TDataSource);
begin
FDataLink.DataSource := Value;
if not (csLoading in ComponentState) then
ActiveChanged;
if Value <> nil then Value.FreeNotification(Self);
end;
function TDZNavigator.GetDataSource: TDataSource;
begin
Result := FDataLink.DataSource;
end;
procedure TDZNavigator.Loaded;
var
W, H: Integer;
begin
inherited Loaded;
W := Width;
H := Height;
SetSize(W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds (Left, Top, W, H);
InitHints;
ActiveChanged;
end;
{TNavButton}
destructor TNavButton.Destroy;
begin
if FRepeatTimer <> nil then
FRepeatTimer.Free;
inherited Destroy;
end;
procedure TNavButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown (Button, Shift, X, Y);
if nsAllowTimer in FNavStyle then
begin
if FRepeatTimer = nil then
FRepeatTimer := TTimer.Create(Self);
FRepeatTimer.OnTimer := TimerExpired;
FRepeatTimer.Interval := InitRepeatPause;
FRepeatTimer.Enabled := True;
end;
end;
procedure TNavButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp (Button, Shift, X, Y);
if FRepeatTimer <> nil then
FRepeatTimer.Enabled := False;
end;
procedure TNavButton.TimerExpired(Sender: TObject);
begin
FRepeatTimer.Interval := RepeatPause;
if (FState = bsDown) and MouseCapture then
begin
try
Click;
except
FRepeatTimer.Enabled := False;
raise;
end;
end;
end;
procedure TNavButton.Paint;
var
R: TRect;
begin
inherited Paint;
if (GetFocus = Parent.Handle) and
(FIndex = TDZNavigator (Parent).FocusedButton) then
begin
R := Bounds(0, 0, Width, Height);
InflateRect(R, -3, -3);
if FState = bsDown then
OffsetRect(R, 1, 1);
Canvas.Brush.Style := bsSolid;
Font.Color := clBtnShadow;
DrawFocusRect(Canvas.Handle, R);
end;
end;
{ TNavDataLink }
constructor TNavDataLink.Create(ANav: TDZNavigator);
begin
inherited Create;
FNavigator := ANav;
VisualControl := True;
end;
destructor TNavDataLink.Destroy;
begin
FNavigator := nil;
inherited Destroy;
end;
procedure TNavDataLink.EditingChanged;
begin
if FNavigator <> nil then FNavigator.EditingChanged;
end;
procedure TNavDataLink.DataSetChanged;
begin
if FNavigator <> nil then FNavigator.DataChanged;
end;
procedure TNavDataLink.ActiveChanged;
begin
if FNavigator <> nil then FNavigator.ActiveChanged;
end;
end. |
