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.
代码如下:
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.