各位英雄!来帮忙吧!DBNavigator控件修改(内容中有经典的DBNavigator源码) ( 积分: 100 )

  • 主题发起人 主题发起人 lai_ke
  • 开始时间 开始时间
L

lai_ke

Unregistered / Unconfirmed
GUEST, unregistred user!
请各位在以下DBNavigator控件中增加ONPOST与OnCanceL事件
代码如下:
unit DBNavPro;
//Ulysses 2003/05/30 00:14 am
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, DBCtrls, Buttons;

const
DBNavProVersion = '2.1';

type
TDBNavPro = class(TDBNavigator)
private
{ Private declarations }
DoCaptions: boolean;
FCaptions: TStrings;
FLayout: TButtonLayout;
FSpacing: Integer;
FMargin: Integer;
protected
{ Protected declarations }
procedure SetGlyphs(Index: TNavigateBtn; Glyph: TBitmap);
function GetGlyphs(Index: TNavigateBtn): TBitmap;

procedure SetLayout(value: TButtonLayout);
procedure SetSpacing(value: integer);
procedure SetMargin(value: integer);
procedure SetCaptions(value: TStrings);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Glyphs[Index: TNavigateBtn]: TBitmap read GetGlyphs write
SetGlyphs;
published
{ Published declarations }

property Captions: TStrings read FCaptions write SetCaptions;
property Layout: TButtonLayout read FLayout write SetLayout default
blGlyphTop;
property Spacing: Integer read FSpacing write SetSpacing default 2;
{if we dont set default, the SetMargin is called}
{this will allow us to put the SetCaptions in as it is not called!}
property Margin: Integer read FMargin write SetMargin;
property Font;

property GlyphFirst: TBitmap index nbFirst read GetGlyphs write SetGlyphs;
property GlyphPrior: TBitmap index nbPrior read GetGlyphs write SetGlyphs;
property GlyphNext: TBitmap index nbNext read GetGlyphs write SetGlyphs;
property GlyphLast: TBitmap index nbLast read GetGlyphs write SetGlyphs;
property GlyphInsert: TBitmap index nbInsert read GetGlyphs write SetGlyphs;
property GlyphDelete: TBitmap index nbDelete read GetGlyphs write SetGlyphs;
property GlyphEdit: TBitmap index nbEdit read GetGlyphs write SetGlyphs;
property GlyphPost: TBitmap index nbPost read GetGlyphs write SetGlyphs;
property GlyphCancel: TBitmap index nbCancel read GetGlyphs write SetGlyphs;
property GlyphRefresh: TBitmap index nbRefresh read GetGlyphs write
SetGlyphs;
end;

procedure Register;

implementation

const
DefaultCaption: array[0..9] of string =
('First', 'Prior', 'Next', 'Last', 'Insert',
'Delete', 'Edit', 'Accept', 'Undo', 'Refresh');

{******************************************************************************}

constructor TDBNavPro.Create(AOwner: TComponent);
var
x: integer;
begin
inherited create(AOwner);
{initialize values}
FCaptions := TStringList.create;
DoCaptions := True;
FSpacing := 0;
SetSpacing(2);
FMargin := 0;
SetMargin(-1);
FLayout := blGlyphBottom;
SetLayout(blGlyphTop);
FCaptions.Clear;
for x := 0 to 9 do
FCaptions.Add(DefaultCaption[x]);
SetCaptions(FCaptions);
end; {of Create}

{******************************************************************************}

destructor TDBNavPro.Destroy;
begin
FCaptions.Free;
inherited Destroy;
end; {of destroy}

{******************************************************************************}

procedure TDBNavPro.SetCaptions(Value: TStrings);
var
t: TNavigateBtn;
begin
{set captions or default if not assigned}
if Value <> FCaptions then
FCaptions.Assign(Value);
for t := low(TNavigateBtn) to high(TNavigateBtn) do
begin
if ord(t) < Value.Count then
Buttons[t].caption := Value[ord(t)]
else
Buttons[t].caption := DefaultCaption[ord(t)];
end;
Invalidate;
end; {of setCaptions}

{******************************************************************************}

procedure TDBNavPro.SetLayout(value: TButtonLayout);
var
t: TNavigateBtn;
begin
if (value = Flayout) and not (csLoading in ComponentState) then
exit;
FLayout := value;
for t := low(TNavigateBtn) to high(TNavigateBtn) do
Buttons[t].Layout := value;
Invalidate;
end; {of SetLayout}

{******************************************************************************}

procedure TDBNavPro.SetSpacing(value: integer);
var
t: TNavigateBtn;
begin
if (value = FSpacing) and not (csLoading in ComponentState) then
exit;
FSpacing := value;
for t := low(TNavigateBtn) to high(TNavigateBtn) do
Buttons[t].Spacing := value;
Invalidate;
end; {of SetSpacing}

{******************************************************************************}

procedure TDBNavPro.SetMargin(value: integer);
var
t: TNavigateBtn;
begin
if (value = FMargin) and not (csLoading in ComponentState) then
exit;
if (csLoading in ComponentState) then
SetCaptions(FCaptions);
FMargin := value;
for t := low(TNavigateBtn) to high(TNavigateBtn) do
Buttons[t].margin := value;
Invalidate;
end; {of SetMargin}

procedure TDBNavPro.SetGlyphs(Index: TNavigateBtn; Glyph: TBitmap);
begin
Buttons[Index].Glyph.Assign(Glyph);
end;

function TDBNavPro.GetGlyphs(Index: TNavigateBtn): TBitmap;
begin
Result := Buttons[Index].Glyph;
end;

{******************************************************************************}

procedure Register;
begin
RegisterComponents('Data Controls', [TDBNavPro]);
end; {of Register}
{of uniut}
end.
 
请各位在以下DBNavigator控件中增加ONPOST与OnCanceL事件
代码如下:
unit DBNavPro;
//Ulysses 2003/05/30 00:14 am
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, DBCtrls, Buttons;

const
DBNavProVersion = '2.1';

type
TDBNavPro = class(TDBNavigator)
private
{ Private declarations }
DoCaptions: boolean;
FCaptions: TStrings;
FLayout: TButtonLayout;
FSpacing: Integer;
FMargin: Integer;
protected
{ Protected declarations }
procedure SetGlyphs(Index: TNavigateBtn; Glyph: TBitmap);
function GetGlyphs(Index: TNavigateBtn): TBitmap;

procedure SetLayout(value: TButtonLayout);
procedure SetSpacing(value: integer);
procedure SetMargin(value: integer);
procedure SetCaptions(value: TStrings);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Glyphs[Index: TNavigateBtn]: TBitmap read GetGlyphs write
SetGlyphs;
published
{ Published declarations }

property Captions: TStrings read FCaptions write SetCaptions;
property Layout: TButtonLayout read FLayout write SetLayout default
blGlyphTop;
property Spacing: Integer read FSpacing write SetSpacing default 2;
{if we dont set default, the SetMargin is called}
{this will allow us to put the SetCaptions in as it is not called!}
property Margin: Integer read FMargin write SetMargin;
property Font;

property GlyphFirst: TBitmap index nbFirst read GetGlyphs write SetGlyphs;
property GlyphPrior: TBitmap index nbPrior read GetGlyphs write SetGlyphs;
property GlyphNext: TBitmap index nbNext read GetGlyphs write SetGlyphs;
property GlyphLast: TBitmap index nbLast read GetGlyphs write SetGlyphs;
property GlyphInsert: TBitmap index nbInsert read GetGlyphs write SetGlyphs;
property GlyphDelete: TBitmap index nbDelete read GetGlyphs write SetGlyphs;
property GlyphEdit: TBitmap index nbEdit read GetGlyphs write SetGlyphs;
property GlyphPost: TBitmap index nbPost read GetGlyphs write SetGlyphs;
property GlyphCancel: TBitmap index nbCancel read GetGlyphs write SetGlyphs;
property GlyphRefresh: TBitmap index nbRefresh read GetGlyphs write
SetGlyphs;
end;

procedure Register;

implementation

const
DefaultCaption: array[0..9] of string =
('First', 'Prior', 'Next', 'Last', 'Insert',
'Delete', 'Edit', 'Accept', 'Undo', 'Refresh');

{******************************************************************************}

constructor TDBNavPro.Create(AOwner: TComponent);
var
x: integer;
begin
inherited create(AOwner);
{initialize values}
FCaptions := TStringList.create;
DoCaptions := True;
FSpacing := 0;
SetSpacing(2);
FMargin := 0;
SetMargin(-1);
FLayout := blGlyphBottom;
SetLayout(blGlyphTop);
FCaptions.Clear;
for x := 0 to 9 do
FCaptions.Add(DefaultCaption[x]);
SetCaptions(FCaptions);
end; {of Create}

{******************************************************************************}

destructor TDBNavPro.Destroy;
begin
FCaptions.Free;
inherited Destroy;
end; {of destroy}

{******************************************************************************}

procedure TDBNavPro.SetCaptions(Value: TStrings);
var
t: TNavigateBtn;
begin
{set captions or default if not assigned}
if Value <> FCaptions then
FCaptions.Assign(Value);
for t := low(TNavigateBtn) to high(TNavigateBtn) do
begin
if ord(t) < Value.Count then
Buttons[t].caption := Value[ord(t)]
else
Buttons[t].caption := DefaultCaption[ord(t)];
end;
Invalidate;
end; {of setCaptions}

{******************************************************************************}

procedure TDBNavPro.SetLayout(value: TButtonLayout);
var
t: TNavigateBtn;
begin
if (value = Flayout) and not (csLoading in ComponentState) then
exit;
FLayout := value;
for t := low(TNavigateBtn) to high(TNavigateBtn) do
Buttons[t].Layout := value;
Invalidate;
end; {of SetLayout}

{******************************************************************************}

procedure TDBNavPro.SetSpacing(value: integer);
var
t: TNavigateBtn;
begin
if (value = FSpacing) and not (csLoading in ComponentState) then
exit;
FSpacing := value;
for t := low(TNavigateBtn) to high(TNavigateBtn) do
Buttons[t].Spacing := value;
Invalidate;
end; {of SetSpacing}

{******************************************************************************}

procedure TDBNavPro.SetMargin(value: integer);
var
t: TNavigateBtn;
begin
if (value = FMargin) and not (csLoading in ComponentState) then
exit;
if (csLoading in ComponentState) then
SetCaptions(FCaptions);
FMargin := value;
for t := low(TNavigateBtn) to high(TNavigateBtn) do
Buttons[t].margin := value;
Invalidate;
end; {of SetMargin}

procedure TDBNavPro.SetGlyphs(Index: TNavigateBtn; Glyph: TBitmap);
begin
Buttons[Index].Glyph.Assign(Glyph);
end;

function TDBNavPro.GetGlyphs(Index: TNavigateBtn): TBitmap;
begin
Result := Buttons[Index].Glyph;
end;

{******************************************************************************}

procedure Register;
begin
RegisterComponents('Data Controls', [TDBNavPro]);
end; {of Register}
{of uniut}
end.
 
正线等待!问题解决马上给分!!
 
各位英雄!来帮忙吧!
 
你都没有说你的问题,我猜测你是想加一个事件,叫OnCancel吧,如果是那样的话。你应该去好好看看TDBNavigator的代码,你现在是实现了设置图片,可以用同样的方式设置按钮事件,实际上你应该去考虑这个事件应有两个,一个是Cancel前,一个Cancel后,都是数据集的事件

TDBNavigator的published里面有一个事件是
property OnClick: ENavClick read FOnNavClick write FOnNavClick;对应各个不同的按钮
你可以参考写一个OnCancel事件也行
另外有一个public的过程
procedure BtnClick(Index: TNavigateBtn); virtual;,在这里系统会procedure TDBNavigator.ClickHandler(Sender: TObject);
begin
BtnClick (TNavButton (Sender).Index);
end;的时候调用那个函数,而这个ClickHandler正是对应的每个按钮的点击事件

procedure TDBNavPro.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;

还没弄明白你要实现什么,说点建议,供参考
 
后退
顶部