dbnavpro.pas

增强型导航条控件,实现了中文标题,欢迎下栽试用,本控件为修改DBNavPro控件制作

unit DBNavPro;

//根据  DBNavPLUS 修改，BUTTON‘S CAPTION，MARGIN，LAYOUT，增加
//基本BUTTON的自定义GLYGH。DELPHI附带的太难看了。INFOPOWER支持GLYPH
//但是不支持LAYOUT，也很不爽，从网上找了一些资料弄了一个小时搞定。
//花了三个小时，满意的NAVIGATOR还没有做出来，图比较的难找。

//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;
    FButtonSet:TNavigatorbuttonSet;
    procedure SetButtonSet(const value:TNavigatorButtonSet);
  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;
    property ButtonSet :TNavigatorButtonSet read FButtonset
  write SetButtonSet;
  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 TJLSDBNavPlus.SetButtonSet(const value:TNavigatorButtonSet);
const
  full_set=[nbfirst,nbprior,nbnext,nblast,nbinsert,nbdelete,nbedit,nbpost,
     nbcancel];
  mid_set=[nbfirst,nbprior,nbnext,nblast,nbedit,nbpost,nbcancel];
  little_set=[nbfirst,nbprior,nbnext,nblast];
sets : array[TNavigatorButtonSet] of TButtonSet =(full_set,mid_set,little_set);
begin
  if(FButtonSet=value) then exit;
  FButtonSet:=value;
  VisibleButtons :=sets[FButtonSet];
end;
{******************************************************************************}

procedure Register;
begin
  RegisterComponents('Data Controls', [TDBNavPro]);
end; {of Register}
{of uniut}
end.