dxbuttons.pas

来自「delphi控件可以很好实现应用程序的界面设计」· PAS 代码 · 共 898 行 · 第 1/2 页

{*******************************************************************}
{                                                                   }
{   dxButtons (Design eXperience)                                   }
{                                                                   }
{   Copyright (c) 2002 APRIORI business solutions AG                }
{   (W)ritten by M. Hoffmann - ALL RIGHTS RESERVED.                 }
{                                                                   }
{   DEVELOPER NOTES:                                                }
{   ==========================================================      }
{   This file is part of a component suite called Design            }
{   eXperience and may be used in freeware- or commercial           }
{   applications. The package itself is distributed as              }
{   freeware with full sourcecodes.                                 }
{                                                                   }
{   Feel free to fix bugs or include new features if you are        }
{   familiar with component programming. If so, please email        }
{   me your modifications, so it will be possible for me to         }
{   include nice improvements in further releases:                  }
{                                                                   }
{*******************************************************************}

unit dxButtons;

interface

uses
  Windows, Classes, Graphics, Controls, Forms, ActnList, ImgList,
  dxCore, dxCoreUtils, TypInfo;

type
{ TdxCustomButtonActionLink }

  TdxCustomButtonActionLink = class(TWinControlActionLink)
  protected
    { Protected declarations }
    function IsImageIndexLinked: Boolean; override;
    procedure AssignClient(AClient: TObject); override;
    procedure SetImageIndex(Value: Integer); override;
  public
    { Public declarations }
    destructor Destroy; override;
  end;

{ TdxCustomButton }

  TdxLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);

  TdxCustomButton = class(TdxCustomStyleControl)
  private
    { Private declarations }
    FAutoGray: Boolean;
    FBgGradient: TBitmap;
    FCancel: Boolean;
    FCkGradient: TBitmap;
    FDefault: Boolean;
    FFcGradient: TBitmap;
    FGlyph: TBitmap;
    FHlGradient: TBitmap;
    FImageChangeLink: TChangeLink;
    FImageIndex: Integer;
    FLayout: TdxLayout;
    FShowAccelChar: Boolean;
    FShowFocusRect: Boolean;
    FSmoothEdges: Boolean;
    FSpacing: Byte;
    FWordWrap: Boolean;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure ImageListChange(Sender: TObject);
  protected
    { Protected declarations }
    function GetActionLinkClass: TControlActionLinkClass; override;
    function IsSpecialDrawState(IgnoreDefault: Boolean = False): Boolean;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure SetAutoGray(Value: Boolean); virtual;
    procedure SetDefault(Value: Boolean); virtual;
    procedure SetGlyph(Value: TBitmap); virtual;
    procedure SetLayout(Value: TdxLayout); virtual;
    procedure SetShowAccelChar(Value: Boolean); virtual;
    procedure SetShowFocusRect(Value: Boolean); virtual;
    procedure SetSmoothEdges(Value: Boolean); virtual;
    procedure SetSpacing(Value: Byte); virtual;
    procedure SetWordWrap(Value: Boolean); virtual;
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure HookResized; override;
  published
    { Published declarations }

    // common properties.
    property Action;
    property Caption;
    property Enabled;
    property TabOrder;
    property TabStop default True;
    property Height default 21;
    property Width default 73;

    // advanced properties.
    property AutoGray: Boolean read FAutoGray write SetAutoGray default True;
    property Cancel: Boolean read FCancel write FCancel default False;
    property Default: Boolean read FDefault write SetDefault default False;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property Layout: TdxLayout read FLayout write SetLayout default blGlyphLeft;
    property ModalResult;
    property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
    property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default False;
    property SmoothEdges: Boolean read FSmoothEdges write SetSmoothEdges default True;
    property Spacing: Byte read FSpacing write SetSpacing default 3;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  end;

{ TdxButton }

  TdxButton = class(TdxCustomButton);

{ TdxToolType }

  TdxToolType = (ttArrowLeft, ttArrowRight, ttClose, ttMaximize, ttMinimize,
    ttPopup, ttRestore);

{ TdxCustomToolButton }

  TdxCustomToolButton = class(TdxCustomStyleControl)
  private
    { Private declarations }
    FToolType: TdxToolType;
  protected
    { Protected declarations }
    procedure SetToolType(Value: TdxToolType); virtual;
    procedure Paint; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure HookResized; override;
  published
    { Published declarations }
    property Enabled;
    property Color default clBlack;
    property Height default 15;
    property ToolType: TdxToolType read FToolType write SetToolType default ttClose;
    property Width default 15;
  end;

{ TdxToolButton }

  TdxToolButton = class(TdxCustomToolButton);

implementation

{ TdxCustomButtonActionLink }

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButtonActionLink.AssignClient
  Author:    mh
  Date:      09-Apr-2002
  Arguments: AClient: TObject
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TdxCustomButton;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButtonActionLink.Destroy
  Author:    mh
  Date:      12-Apr-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

destructor TdxCustomButtonActionLink.Destroy;
begin
  TdxCustomButton(FClient).Invalidate;
  inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButtonActionLink.IsImageIndexLinked
  Author:    mh
  Date:      09-Apr-2002
  Arguments: None
  Result:    Boolean
-----------------------------------------------------------------------------}

function TdxCustomButtonActionLink.IsImageIndexLinked: Boolean;
begin
  Result := True;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButtonActionLink.SetImageIndex
  Author:    mh
  Date:      09-Apr-2002
  Arguments: Value: Integer
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButtonActionLink.SetImageIndex(Value: Integer);
begin
  inherited;
  (FClient as TdxCustomButton).FImageIndex := Value;
  (FClient as TdxCustomButton).Invalidate;
end;

{ TdxCustomButton }

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.Create
  Author:    mh
  Date:      21-Feb-2002
  Arguments: AOwner: TComponent
  Result:    None
-----------------------------------------------------------------------------}

constructor TdxCustomButton.Create(AOwner: TComponent);
begin
  inherited;

  // set default properties.
  ControlStyle := ControlStyle - [csDoubleClicks];
  Height := 21;
  Width := 73;
  TabStop := True;

  // set custom properties.
  FAutoGray := True;
  FCancel := False;
  FDefault := False;
  FImageIndex := -1;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FGlyph := TBitmap.Create;
  FLayout := blGlyphLeft;
  FShowAccelChar := True;
  FShowFocusRect := False;
  FSmoothEdges := True;
  FSpacing := 3;
  FWordWrap := True;

  // create ...
  FBgGradient := TBitmap.Create; // background gradient
  FCkGradient := TBitmap.Create; // clicked gradient
  FFcGradient := TBitmap.Create; // focused gradient
  FHlGradient := TBitmap.Create; // Highlight gradient
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.Destroy
  Author:    mh
  Date:      21-Feb-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

destructor TdxCustomButton.Destroy;
begin
  FBgGradient.Free;
  FCkGradient.Free;
  FFcGradient.Free;
  FHlGradient.Free;
  FGlyph.Free;
  FImageChangeLink.OnChange := nil;
  FImageChangeLink.Free;
  FImageChangeLink := nil;
  inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.GetActionLinkClass
  Author:    mh
  Date:      09-Apr-2002
  Arguments: None
  Result:    TControlActionLinkClass
-----------------------------------------------------------------------------}

function TdxCustomButton.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TdxCustomButtonActionLink;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.CMDialogKey
  Author:    mh
  Date:      22-Feb-2002
  Arguments: var Message: TCMDialogKey
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.CMDialogKey(var Message: TCMDialogKey);
begin
  inherited;
  with Message do
    if (((CharCode = VK_RETURN) and (Focused or (FDefault and not (IsSibling))))
      or ((CharCode = VK_ESCAPE) and FCancel) and (KeyDataToShiftState(KeyData) = []))
      and CanFocus then
    begin
      Click;
      Result := 1;
    end
    else
      inherited;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.SetAutoGray
  Author:    mh
  Date:      12-Apr-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.SetAutoGray(Value: Boolean);
begin
  if Value <> FAutoGray then
  begin
    FAutoGray := Value;
    if not IsLocked then
      Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.SetDefault
  Author:    mh
  Date:      22-Feb-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.SetDefault(Value: Boolean);
begin
  if Value <> FDefault then
  begin
    FDefault := Value;
    with GetParentForm(Self) do
      Perform(CM_FOCUSCHANGED, 0, LongInt(ActiveControl));
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.SetGlyph
  Author:    mh
  Date:      22-Feb-2002
  Arguments: Value: TPicture
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.SetGlyph(Value: TBitmap);
begin
  FGlyph.Assign(Value);
  if not IsLocked then
    Invalidate;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.SetLayout
  Author:    mh
  Date:      12-Apr-2002
  Arguments: Value: TdxLayout
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.SetLayout(Value: TdxLayout);
begin
  if Value <> FLayout then
  begin
    FLayout := Value;
    if not IsLocked then
      Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.SetShowAccelChar
  Author:    mh
  Date:      22-Feb-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.SetShowAccelChar(Value: Boolean);
begin
  if Value <> FShowAccelChar then
  begin
    FShowAccelChar := Value;
    if not IsLocked then
      Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.SetShowFocusRect
  Author:    mh
  Date:      22-Feb-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.SetShowFocusRect(Value: Boolean);
begin
  if Value <> FShowFocusRect then
  begin
    FShowFocusRect := Value;
    if not IsLocked then
      Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.SetSmoothEdges
  Author:    mh
  Date:      05-Jul-2002
  Arguments: Value: Boolean
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.SetSmoothEdges(Value: Boolean);
begin
  if Value <> FSmoothEdges then
  begin
    FSmoothEdges := Value;
    if not IsLocked then
      Invalidate;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxCustomButton.SetSpacing
  Author:    mh
  Date:      11-Apr-2002
  Arguments: Value: Integer
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxCustomButton.SetSpacing(Value: Byte);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    if not IsLocked then