gradbtn.pas

DBchart的高级使用

unit GradBtn;
{This component is freeware.  Use, abuse it, modify it, improve it, take out
 parts you don't need/want.  You don't need to credit the author if you use
 this in an application.  However, you can communicate with me at
 [e-mail] }

{Version 1.0 11/97 Initial release to the Public
 Version 1.1 12/97 Added Presets.  Add KeyPress to allow Enter key to act as
              Click. Also added btnFrameSize property, but I don't like it much
	     'cause it overlays the gradient, and I'm too lazy to figure
             out a solution.
 Version 1.2 01/98
             Tony BenBrahim ([e-mail]) made a VAST improvement by
             adding drawing and handling for accelerator keys(&).  Thanks, Tony!
             Fixed bug - made tsRaised the default TextStyle.
             Added code to indicate if button has Focus.
             Added two events - OnMouseEnter and OnMouseLeave.
             Cleaned up code a little.
 Version 1.3 07/98
             Added Justification property for alignment of caption, per a
             suggestion from Yves MailHot. Thanks!
 Version 1.4 02/99
             Added code to Re-Draw Button back to its original state if
             mouse is down and moved away, to more closely resemble a typical
             button behavior.  Suggestion and code from Andy Daxer, Munich.
             Also modified the code for the Elliptic style of gradient to use
             integer math instaed of real numbers, greatly improving the speed
             of redraw.  The code was contributed by Dr. Allan Harkness, from
             Paisley, Scotland.  Thanks a great deal to you both, this component
             keeps getting better all the time, with insightful and generous
             help from people like you. Dr. Harkin has also shared other
             improvements as follows:  When button is disabled, it looks that
             way.  Drop-down menu support, you can associate a popup menu with
             the button (the little triangle thingy).  A new preset called
             Brassed Off.  NOTE - Drop down menu support only available with D4.
             I also changed the code so that the button is always re-drawn on
             a click.  There was a bug where if a user program error occured
             in the OnClick code, the button was left in a 'down' state.  I
             _think_ I fixed this...}

interface

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

{I learned the basic gradient technique from a component by John Baumbach.
 I added several more types of gradient and 3D text.  His component was
 derived from a SpeedButton.  I found his component at the Delphi Deli,
 (www.delphideli.com), a great place on the Web.  There are a lot of
 comments in here, which kind of trashes up the code, but I wanted to
 make this understandable to just about anybody, so have tried to explain
 everything that's going on.}

{These are the six different gradient styles available.}
type
  TGradientStyle = (gsHorizontal, gsVertical, gsElliptic, gsRectangle,
                    gsVertCenter, gsHorizCenter);

{Text can be normal, or 3D raised/inset}
type
  TTextStyle = (tsNormal, tsRaised, tsInset);

{ShadeType refers to the 3D text effect.}
type
  TShadeType = (stLight, stHeavy);

{Added some presets to make things easier}
type
  TPreset = (None, GoldCoast, LimeBox, Aluminum, SunRise, BrassedOff);

{Added justification for caption.}
type
  TJustification = (jLeft, jCenter, jRight);

type
  TGradBtn = class(TCustomControl)
  private
    { Private declarations }
    {$IFDEF VER120}
    FMenuPoppedUp : Boolean;  //Added AH 13/2/99
    FDropdownMenu: TPopupMenu;//Added AH 13/2/99
    FMarkerOffset : Integer;  //Added AH 13/2/99
    {$ENDIF}
    FDisabledColor : TColor;  //Added AH 13/2/99 Color when control is disabled
    FBtnHiliteClr : TColor;   //Hilite around button
    FBtnShadowClr : TColor;   //Shadow around button
    FBtnFrameSize : Integer;  //Size of 3D Frame
    FTxtHiliteClr : TColor;  //Text Hilite
    FTxtShadowClr : TColor;  //Text Shadow
    FBeginClr : TColor;    //Start color for gradient
    FEndClr : TColor;     //End color for gradient
    FSwapClr : Boolean;    //Swap start-end colors on button press?
    FShowFocus : Boolean;  //Show indicator rectangle when we have focus?
    FGradientStyle : TGradientStyle;  //One of six choices
    FTextStyle : TTextStyle;  //Raised, Inset, or None
    FShadeType : TShadeType; //Light or heavy text shading
    FOnMouseEnter: TNotifyEvent;  //Make the Mouse Enter and Leave available
    FOnMouseLeave: TNotifyEvent;
    FJustify : TJustification;   //Allow for left/center/right justify
    mUp : Boolean;    //Flags for Mouse Up or Down
    Clicking : Boolean;   //To catch a real button click...
    bm : TBitmap;          //WorkHorse internal bmp
    TmpClr : TColor;       //Holding area for Color during Mouse Down.
    FPreset : TPreset;   //Variable for presets
    Caption2: string; //ABB caption w/out ampersand!
    function Muldv(a,b,c : integer) : longint;
    procedure WMSetFocus(Var Msg : TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(Var Msg : TWMKillFocus); message WM_KILLFOCUS;
    //I had to add this to get the Caption to change while designing
    procedure CMMouseEnter(var Msg:TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Msg:TMessage); message CM_MOUSELEAVE;
    //Processing these messages allows events to fire when mouse enters or leaves
    procedure CMTextChanged(var Msg:TMessage); message CM_TEXTCHANGED;
    {$IFNDEF VER120}
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    {$ENDIF}
    procedure WMEraseBkgnd(Var Msg : TMessage); message WM_ERASEBKGND;
    //I added this to help reduce flicker and speed things up.
    procedure KeyAccel(var Message: TCMDialogChar);message CM_DIALOGCHAR;
    procedure SetDisabledColor(Value: TColor); //Added AH 13/2/99 Set color when control is disabled
    procedure SetBtnHilite(Value: TColor);  //Set color of top and left of frame
    procedure SetBtnShadow(Value: TColor);  //Set Color of right and bottom of frame
    procedure SetBtnFrameSize(Value: Integer); //Set size of 3D frame
    procedure SetTxtHilite(Value: TColor);  //Set color for text 3D effect hilite
    procedure SetTxtShadow(Value: TColor);  //Set color for text 3D effect shadow
    procedure SetBeginClr(Value : TColor);  //Set start color of gradient
    procedure SetEndClr(Value : TColor);    //Set end color of gradient
    procedure SetSwap(Value : Boolean);  //Swap the start-end true-false
    procedure SetShowFocus(Value : Boolean);  //Draw Rect when we have focus T/F
    procedure SetStyle(Value: TTextStyle);  //Set Caption 3D style
    procedure SetShade(Value: TShadeType);  //Set Caption shading type
    procedure SetPreset(Value: TPreset);   //Set preset values
    procedure DoRaise(offset: Integer);   //This draws the 3D Caption 'raised'
    procedure DoInset(offset: Integer);  //This draws te 3D caption 'inset'
    procedure DoNorm(offset: Integer);   //This draws the caption with no 3D
    procedure SetGradient(Value : TGradientStyle);  //Choose gradient fill style
    procedure SetJustify(Value : TJustification);   //Select caption justification
    procedure DoHorizontal(fr, fg, fb, dr, dg, db : Integer); //These all draw
    procedure DoVertical(fr, fg, fb, dr, dg, db : Integer); // the gradients.
    procedure DoElliptic(fr, fg, fb, dr, dg, db : Integer); // The fr fg fb etc
    procedure DoRectangle(fr, fg, fb, dr, dg, db : Integer); // are color values.
    procedure DoVertCenter(fr, fg, fb, dr, dg, db : Integer);
    procedure DoHorizCenter(fr, fg, fb, dr, dg, db : Integer);
    {$IFDEF VER120}
    procedure SetDropdownMenu (Value: TPopupMenu); //Added AH 13/2/99
    procedure DrawPopupMark;			   //Added AH 13/2/99
    {$ENDIF}
  protected
    { Protected declarations }
    {I added the following to allow the Enter key to behave as a Click.}
    procedure KeyPress(var Key: Char); override;
    {$IFDEF VER120}
    procedure Notification (AComponent: TComponent; Operation: TOperation); override; //Added AH 13/2/99
    {$ENDIF}
    procedure SetEnabled(value: Boolean); {$IFDEF VER120}override;{$ENDIF} //Added AH 13/2/99
  public
    { Public declarations }
    {Almost all components override the constructor, so that default values for
     new properties can be set.  The destructor is usually overridden so cleanup
     can be done - like releasing resources so they don't cause memory leaks.}
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;  //Override Paint - entire control is painted.
    procedure MouseDown(Button:TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState;
      X, Y: Integer); override;
    //Mouse up and down are what I use to swap gradient colors
    procedure Click; override;
  published
    { Published declarations }
    {This first batch of stuff is all the new properties I added for this
     component.  As long as the properties are part of the usual types, you
     don't have to define your own property editor. I love Delphi.}
    property DisabledColor : TColor read FDisabledColor
       write SetDisabledColor default clGrayText; // Added by AH 13/2/99
    property BtnHiliteClr : TColor read FBtnHiliteClr
       write SetBtnHilite default clBtnHighLight;
    property BtnShadowClr : TColor read FBtnShadowClr
       write SetBtnShadow default clBtnShadow;
    property BtnFrameSize : Integer read FBtnFrameSize
       write SetBtnFrameSize default 1;
    property TxtHiliteClr : TColor read FTxtHiliteClr
       write SetTxtHilite default clBtnHighLight;
    property TxtShadowClr : TColor read FTxtShadowClr
       write SetTxtShadow default clBtnShadow;
    property BeginColor : TColor read FBeginClr
       write SetBeginClr default clNavy;
    property EndColor : TColor read FEndClr
       write SetEndClr default clAqua;
    property SwapColors : Boolean read FSwapClr
       write SetSwap default TRUE;
    property ShowFocus : Boolean read FShowFocus
       write SetShowFocus default TRUE;
    property GradientStyle : TGradientStyle read FGradientStyle
       write SetGradient default gsVertCenter;
    property TextStyle : TTextStyle read FTextStyle
       write SetStyle default tsRaised;
    property TextShadeType : TShadeType read FShadeType
       write SetShade default stLight;
    property Presets : TPreset read FPreset
       write SetPreset default None;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter
        write FOnMouseEnter;   //These show up in events
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave
        write FOnMouseLeave;
    property Justification : TJustification read FJustify
       write SetJustify default jCenter;
    {$IFDEF VER120}
    property DropdownMenu: TPopupMenu read FDropdownMenu write SetDropdownMenu; // Added by AH 13/2/99
    {$ENDIF}
    property Caption;      //Added these so they show up in the Obj Insp.
    property OnClick;      // When deriving from a Custom type control,
    property OnMouseDown;  // these don't normally show up unless you specifically
    property OnMouseUp;    // declare them yourself.  You can find them by
    property Visible;      // going through the browser.
    property Enabled;
    property Font;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseMove;
  end;

procedure Register;

implementation

constructor TGradBtn.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  {$IFDEF VER120}
  FMenuPoppedUp := False; // Added by AH 13/2/99 
  FMarkerOffset := 0; // Added by AH 13/2/99 offset if drop down menu used
  {$ENDIF}
  FDisabledColor := clGrayText;   // Added by AH 13/2/99 Default disabled Color
  FBtnHiliteClr := clBtnHighLight;   //Default Hilite Color
  FBtnShadowClr := clBtnShadow;      //Default Shadow Color
  FBtnFrameSize := 1;                //Default frame size
  FTxtHiliteClr := clBtnHighLight;   //Default Text Hilite
  FTxtShadowClr := clBtnShadow;      //Default Text Shadow
  FBeginClr := clNavy;            //Start Color is at the Top of button
  FEndClr := clAqua;             //Stop Color is at the Bottom of button
  Height := 25;                   //Default button size
  Width := 75;
  bm := TBitmap.Create;          //Create the internal BMP
  bm.Canvas.Pen.Style:= psSolid; //These may already be the default,
  bm.Canvas.Pen.Mode:= pmCopy;   // but just in case...
  mUp := TRUE;                   //Mouse is UP to start with
  Font.Color := clBlack;         //Default Font Color
  ControlStyle := ControlStyle + [csOpaque];   //This reduces flicker
  FSwapClr := TRUE;               //By default, we swap colors on Mouse Down
  FShowFocus := TRUE;             //Draw focusrect when we have focus
  FShadeType := stLight;          //Light text shading by default
  FTextStyle := tsRaised;         //Raised '3d' text
  FGradientStyle := gsVertCenter;   //Top & Bottom to Center for gradient Fill default
  FPreset := None;
  TabStop := TRUE;      //Made this the default so button can have Focus
  FJustify := jCenter;  //Default is center justify
end;

function TGradBtn.Muldv(a,b,c : integer) : longint;
ASM

  MOV EAX, a
  IMUL b
  IDIV c

end;


{Everything pretty much happens in the Paint procedure; a lot of it is farmed
 out to other procedures just so the logic in the paint procedure can be
 understood a little better.  Here's the basic process for creating a gradient:
 Get the separate R, G, and B values of the BeginClr Color.  Then, find the
 difference between that and the R, G, and B values of the EndClr Color.  Using
 these two sets of values, draw a series of 'shapes' using a series of colors
 between the begin and end.  After the gradient is drawn, add a frame and the
 Caption.}
procedure TGradBtn.Paint;
var
  FromR, FromG, FromB : Integer; //These are the separate color values for RGB
  DiffR, DiffG, DiffB : Integer; // of color values.
  rct : TRect;                   //Rectangle used to draw frame around button
  offset : Integer;              //Used for Caption location during Mouse Down
  i: integer; 			 //loop variable to iterate Caption for &. ABB
{To speed things up and reduce flicker, I use a Bitmap to draw the button in
 its entirety, then BitBlt it to the canvas of the control.}
begin
  //Harm removed this 2/15/99
  //inherited;                  // PROBABLY DON'T NEED THIS
  bm.Canvas.Font.Color := Font.Color; //Keep Bitmap in synch with settings.
  bm.Canvas.Font := Font;     // Set the Bitmap font to match control font
  bm.Width := Width;          //Set BMP dimensions to match control's
  bm.Height := Height;
  rct := Rect(0,0,Width,Height);  //Set rectangle size for later use
  FromR := FBeginClr and $000000ff;  //Strip out separate RGB values
  FromG := (FBeginClr shr 8) and $000000ff;
  FromB := (FBeginClr shr 16) and $000000ff;
  DiffR := (FEndClr and $000000ff) - FromR;   //Find the difference
  DiffG := ((FEndClr shr 8) and $000000ff) - FromG;
  DiffB := ((FEndClr shr 16) and $000000ff) - FromB;
  //Depending on gradient style selected, go draw it on the Bitmap canvas.
  case FGradientStyle of
    gsHorizontal  : DoHorizontal(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    gsVertical    : DoVertical(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    gsElliptic    : DoElliptic(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    gsRectangle   : DoRectangle(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    gsVertCenter  : DoVertCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);
    gsHorizCenter : DoHorizCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);
  end;

  // Added by AH 13/2/99
  {$IFDEF VER120}
  if Assigned (DropDownMenu) then DrawPopupMark;
  {$ENDIF}

  //By setting the Brush style to Clear, it will draw without overlaying bkgrnd
  bm.Canvas.Brush.Style := bsClear;  //Gradient is done, time for Hilite-Shadow
  if mUp = TRUE then begin       //If Mouse up do normal button
    offset := 0;  //offset is used to move the Caption down a notch when the
                  // button is pressed.
    Frame3D(bm.Canvas,rct,FBtnHiliteClr,FBtnShadowClr,FBtnFrameSize); //Draw frame
  end
  else begin
    offset := 1; //If mouse down, we want caption to 'move' and reverse the frame
    Frame3D(bm.Canvas,rct,FBtnShadowClr,FBtnHiliteClr,FBtnFrameSize);
  end;
  //Added by ABB
  Caption2:='';
  if Length(Caption) > 0 then begin
    for i:=1 to Length(Caption)-1 do if (Caption[i]<>'&') or (Caption[i+1]='&') then Caption2:=Caption2+Caption[i];
    Caption2:=Caption2+Caption[Length(Caption)];
  end;
  //End ABB

  // Added by AH 13/2/99
  {$IFDEF VER120}
  if Assigned (DropDownMenu) then
    FMarkerOffset := -6
  else
    FMarkerOffset := 0;
  {$ENDIF}

  // disabled button is inset - Altered by AH 13/2/99
  if not Enabled then DoInset(offset) 
  else
    Case FTextStyle of
      tsInset  : DoInset(offset);
      tsRaised :DoRaise(offset);
      tsNormal :DoNorm(offset);
    end;

  //If we have the Focus, draw a little rectangular indicator.
  if not (csDesigning in ComponentState) then
    if FShowFocus = TRUE then
      if Focused then
        bm.Canvas.DrawFocusRect(RECT(2,  2, Width - 2, Height - 2));
  {Finally, the button is all painted on the bitmap canvas.  Now we just need
   to copy it to the canvas of our control.  BitBlt is one method; there are
   several others.}
  BitBlt(Canvas.Handle,0,0,Width,Height,bm.Canvas.Handle,0,0,SRCCOPY);

  // Added by AH 13/2/99
  {$IFDEF VER120}
  if mUp then FMenuPoppedUp := False; // if button now up, menu must have disappeared
  {$ENDIF}
end;

//Added handler for accelerator key
procedure TGradBtn.KeyAccel(var Message: TCMDialogChar);
begin
  with Message do begin
    if IsAccel(CharCode, Caption) and Enabled then begin
      Click;
      Result := 1;
    end
    else
     inherited;