dxbutton.pas

功能强大的报表生成和管理工具

{*******************************************************************}
{                                                                   }
{   dxButton (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:                  }
{                                                                   }
{   Contact: [e-mail]                                   }
{                                                                   }
{   History:                                                        }
{   =============================================================== }
{   Version 1.0.2e (2002/04/29)                                     }
{     + Added missed "TdxColor" Properties                          }
{                                                                   }
{   Version 1.0.2d (2002/04/29)                                     }
{     + Added "WordWrap" Property                                   }
{     + Added "HotTrack" Property                                   }
{     + Added "TdxColor" Properties                                 }
{                                                                   }
{   Version 1.0.2b+c (2002/04/12)                                   }
{     + Added AutoGray Glyphs                                       }
{       (sorry, icons as Glyphs are not longer supported -          }
{         use actions instead!)                                     }
{     + Added Glyph Layout property                                 }
{     * Fixed ActionLink (Added Destructor)                         }
{                                                                   }
{   Version 1.0.2 (2002/04/09)                                      }
{     * Minor Bugfixes                                              }
{     * Fixed Action behaviour                                      }
{       (Thanks to Rajko Bogdanovic)                                }
{     * Fixed Key-Up/Down methods                                   }
{     + Added "ReadMe.txt" and "WhatsNew.txt"                       }
{     + Added multiple-line support                                 }
{     + Reordered upload structure                                  }
{                                                                   }
{   Version 1.0.1                                                   }
{     + Replaced OwnerDrawState with internal Structure             }
{                                                                   }
{   Version 1.0.0                                                   }
{     + First Release                                               }
{                                                                   }
{*******************************************************************}

unit dxButton;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, ImgList,
  ActnList, SysUtils, dxCore;

resourcestring
  SVersion = '1.0.2e'; // always increase version number on new releases!

const
  //
  // color constants.
  //

  // border edges.
  cColorBorderEdges = $00AD967B;

  // border line.
  cColorBorderLine = $00733C00;

  // hottrack.
  cColorHotTrack = $000000FF;

  // background gradient.
  cColorBkFrom = $00FFFFFF;
  cColorBkTo = $00E7EBEF;

  // clicked gradient.
  cColorCkFrom = $00C6CFD6;
  cColorCkTo = $00EBF3F7;

  // focused gradient.
  cColorFcFrom = $00FFE7CE;
  cColorFcTo = $00EF846D;

  // highlight gradient.
  cColorHlFrom = $00CEF3FF;
  cColorHlTo = $000096E7;

type
{ TdxQuality }

  //
  // The quality in which the gradient will be drawn. 'bgHigh' enables
  // the slower color dithering and have to been used only on larger component
  // dimensions.
  //
  TdxQuality = (bqLow, bqMiddle, bqHigh);

{ TdxLayout }

  //
  // The layout property is used to set the glyph position.
  //
  TdxLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);

{ TdxButtonActionLink }

  TdxButtonActionLink = 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;

{ TdxColors }

  TdxColors = class(TPersistent)
  private
    { Private declarations }
    FBackgroundFrom: TColor;
    FBackgroundTo: TColor;
    FBorderEdges: TColor;
    FBorderLine: TColor;
    FClickedFrom: TColor;
    FClickedTo: TColor;
    FFocusedFrom: TColor;
    FFocusedTo: TColor;
    FHighlightFrom: TColor;
    FHighlightTo: TColor;
    FHotTrack: TColor;
  protected
    { Protected declarations }
    FOwner: TObject;
    procedure SetBackgroundFrom(Value: TColor); virtual;
    procedure SetBackgroundTo(Value: TColor); virtual;
    procedure SetBorderEdges(Value: TColor); virtual;
    procedure SetBorderLine(Value: TColor); virtual;
    procedure SetClickedFrom(Value: TColor); virtual;
    procedure SetClickedTo(Value: TColor); virtual;
    procedure SetFocusedFrom(Value: TColor); virtual;
    procedure SetFocusedTo(Value: TColor); virtual;
    procedure SetHighlightFrom(Value: TColor); virtual;
    procedure SetHighlightTo(Value: TColor); virtual;
    procedure SetHotTrack(Value: TColor); virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent);
  published
    { Published declarations }
    property BackgroundFrom: TColor read FBackgroundFrom write SetBackgroundFrom default cColorBkFrom;
    property BackgroundTo: TColor read FBackgroundTo write SetBackgroundTo default cColorBkTo;
    property BorderEdges: TColor read FBorderEdges write SetBorderEdges default cColorBorderEdges;
    property BorderLine: TColor read FBorderLine write SetBorderLine default cColorBorderLine;
    property ClickedFrom: TColor read FClickedFrom write SetClickedFrom default cColorCkFrom;
    property ClickedTo: TColor read FClickedTo write SetClickedTo default cColorCkTo;
    property FocusedFrom: TColor read FFocusedFrom write SetFocusedFrom default cColorFcFrom;
    property FocusedTo: TColor read FFocusedTo write SetFocusedTo default cColorFcTo;
    property HighlightFrom: TColor read FHighlightFrom write SetHighlightFrom default cColorHlFrom;
    property HighlightTo: TColor read FHighlightTo write SetHighlightTo default cColorHlTo;
    property HotTrack: TColor read FHotTrack write SetHotTrack default cColorHotTrack;
  end;

{ TdxButton }

  TdxButton = class(TdxCustomControl)
  private
    { Private declarations }
    FAutoGray: Boolean;
    FBgGradient: TBitmap;
    FCancel: Boolean;
    FCkGradient: TBitmap;
    FColors: TdxColors;
    FDefault: Boolean;
    FFcGradient: TBitmap;
    FGlyph: TBitmap;
    FHlGradient: TBitmap;
    FHotTrack: Boolean;
    FImageChangeLink: TChangeLink;
    FImageIndex: Integer;
    FLayout: TdxLayout;
    FQuality: TdxQuality;
    FShowAccelChar: Boolean;
    FShowFocusRect: Boolean;
    FSpacing: Byte;
    FWordWrap: Boolean;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure ImageListChange(Sender: TObject);
  protected
    { Protected declarations }
    function GetVersion: string; override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    function IsSpecialDrawState(IgnoreDefault: Boolean = False): Boolean;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure HookResized; 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 SetHotTrack(Value: Boolean); virtual;
    procedure SetLayout(Value: TdxLayout); virtual;
    procedure SetQuality(Value: TdxQuality); virtual;
    procedure SetShowAccelChar(Value: Boolean); virtual;
    procedure SetShowFocusRect(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;
  published
    { Published declarations }
    property Action;
    property AutoGray: Boolean read FAutoGray write SetAutoGray default True;
    property Cancel: Boolean read FCancel write FCancel default False;
    property Caption;
    property Colors: TdxColors read FColors write FColors;
    property Default: Boolean read FDefault write SetDefault default False;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property Height default 25;
    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
    property Layout: TdxLayout read FLayout write SetLayout default blGlyphLeft;
    property ModalResult;
    property TabOrder;
    property TabStop default True;
    property Quality: TdxQuality read FQuality write SetQuality default bqMiddle;
    property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
    property ShowFocusRect: Boolean read FShowFocusRect write SetShowFocusRect default True;
    property Spacing: Byte read FSpacing write SetSpacing default 3;
    property Width default 73;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  end;

procedure Register;

implementation

{-----------------------------------------------------------------------------
  Procedure: Register
  Author:    mh
  Date:      04-Feb-2002
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}

procedure Register;
begin
  RegisterComponents('Design eXperience', [TdxButton]);
end;

{ TdxButtonActionLink }

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

procedure TdxButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TdxButton;
end;

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

destructor TdxButtonActionLink.Destroy;
begin
  TdxButton(FClient).Invalidate;
  inherited;
end;

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

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

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

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

{ TdxColors }

{-----------------------------------------------------------------------------
  Procedure: TdxColors.Create
  Author:    mh
  Date:      29-Apr-2002
  Arguments: AOwner: TComponent
  Result:    None
-----------------------------------------------------------------------------}

constructor TdxColors.Create(AOwner: TComponent);
begin
  inherited Create;
  FBackgroundFrom := cColorBkFrom;
  FBackgroundTo := cColorBkTo;
  FBorderEdges := cColorBorderEdges;
  FBorderLine := cColorBorderLine;
  FClickedFrom := cColorCkFrom;
  FClickedTo := cColorCkTo;
  FFocusedFrom := cColorFcFrom;
  FFocusedTo := cColorFcTo;
  FHighlightFrom := cColorHlFrom;
  FHighlightTo := cColorHlTo;
  FHotTrack := cColorHotTrack;
  FOwner := AOwner;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxColors.SetBackgroundFrom
  Author:    mh
  Date:      29-Apr-2002
  Arguments: Value: TColor
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxColors.SetBackgroundFrom(Value: TColor);
begin
  if Value <> FBackgroundFrom then
  begin
    FBackgroundFrom := Value;
    TdxButton(FOwner).HookResized;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TdxColors.SetBackgroundTo
  Author:    mh
  Date:      29-Apr-2002
  Arguments: Value: TColor
  Result:    None
-----------------------------------------------------------------------------}

procedure TdxColors.SetBackgroundTo(Value: TColor);
begin
  if Value <> FBackgroundTo then