previous_dsfancybutton.pas

componete para dar presentacion a tus aplicaciones es indispensable para una buena presentacion

unit DsFancyButton;

{------------------------------------------------
 DsFancyButton Release 2.2 for Delphi 3 and newer
 Copyright: (c) 1999-2006 by Djoko Susilo
 e-mail   : [e-mail]
 ----------- Q14 Project Feb-99 R1.0 -----------
 Files needed to install:
 DsFancyButton.pas (this file)
 DsFancyButton.dcr (resource for icon)
 -----------------------------------------------
 R1.1 10-Nov-99:
   -Gradient process using region function
 R1.1 22-May-00:
   -Using better region routine to release memory
 R2.0 10-Jan-01:
   -Shape constant of shRoundRect is removed.
    Rounded rectangle can be set through CornerRadius setting.
   -Add property glyph and its layout.
    Max. glyph number is 3 (glyph 1=enable  2=disable  3=pressed)
   -Better button pressing effect.
 R2.1 16-Feb-01:
   -Add hover color when mouse moves over the button.
   update 15-Mar-01:
   -Fix caption position when font is changed.
   update 17-May-01:
   -Add one more glyph to response mouse move
    (glyph 1=enable  2=disable  3=pressed  4=pointed).
   -Remove property TransparentColor. Use standard method in
    checking transparent color (left-bottom corner of glyph).
 R2.1 08-May-01:
   -Restructure the codes to implement property groupings, so setting
    values become much more easier.
   -Redefine button pressing effect. Pressing color is now
    automatically using dimmed color of its face color.
    Greatly improved pressing effect!
   update 14-Apr-02:
    free occupied resources
 R2.2 13-Jul-02:
   -add hovering effect to button face
   -now it has better appearance
 -----------------------------------------------
 thanks to:
   - Danny Indra <[e-mail]>
   - Parker Nolen <[e-mail]>
   - David Hooper <[e-mail]>
   - Hermann Husemann <[e-mail]>
   - Laercio Santana <[e-mail]>
 for feedback, suggestions and improvement notes.
 -----------------------------------------------}


{$R-}
{$B-}
{$H+}   {--always use this compiler directive----}

{--for Delphi 5 and newer--}
{$DEFINE Delphi5} {--disable this line for previous Delphi version--}

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms;

type
  {--Fancy options--}
  TTextStyle = (txNone, txLowered, txRaised, txShadowed);
  TBtnShape = (btnCapsule, btnOval, btnRectangle);
  TFrameStyle = (fmNone, fmGradient);
  TDsEffect = class(TPersistent)
  private
    FButtonColor: TColor;
    FBtnShape: TBtnShape;
    FCornerRadius: Integer;
    FFrameColor: TColor;
    FFrameWidth: Integer;
    FHoverColor: TColor;
    FTextStyle: TTextStyle;
    FFrameStyle: TFrameStyle;
    FOnEffectChange: TNotifyEvent;
    procedure DoChanges;
  protected
    procedure SetButtonColor(Value: TColor);
    procedure SetBtnShape(Value: TBtnShape);
    procedure SetCornerRadius(Value: Integer);
    procedure SetFrameColor(Value: TColor);
    procedure SetFrameStyle(Value: TFrameStyle);
    procedure SetFrameWidth(Value: Integer);
    procedure SetHoverColor(Value: TColor);
    procedure SetTextStyle(Value: TTextStyle);
  public
  published
    property FaceColor: TColor read FButtonColor write SetButtonColor;
    property FrameColor: TColor read FFrameColor write SetFrameColor;
    property FrameStyle: TFrameStyle read FFrameStyle write SetFrameStyle;
    property FrameWidth: Integer read FFrameWidth write SetFrameWidth;
    property HoverColor: TColor read FHoverColor write SetHoverColor;
    property Shape: TBtnShape read FBtnShape write SetBtnShape;
    property CornerRadius: Integer read FCornerRadius write SetCornerRadius;
    property TextStyle: TTextStyle read FTextStyle write SetTextStyle;
    property OnEffectChange: TNotifyEvent read FOnEffectChange write FOnEffectChange;
  end;

  {--Glyph options--}
  TBmpLayout = (lyLeft, lyTop, lyRight, lyBottom, lyCenter);
  TDsGlyph = class(TPersistent)
  private
    FBmpGlyph: TBitmap;
    FBmpLayout: TBmpLayout;
    FGlyphsNum: Byte;
    FGlyphSpace: Integer;
    FOnGlyphChange: TNotifyEvent;
    procedure DoChanges;
  protected
    procedure SetBmpLayout(Value: TBmpLayout);
    procedure SetBmpGlyph(ABmpGlyph: TBitmap);
    procedure SetGlyphsNum(Value: Byte);
    procedure SetGlyphSpace(Value: Integer);
  published
    property Glyph: TBitmap read FBmpGlyph write SetBmpGlyph;
    property Layout: TBmpLayout read FBmpLayout write SetBmpLayout;
    property Number: Byte read FGlyphsNum write SetGlyphsNum;
    property Distance: Integer read FGlyphSpace write SetGlyphSpace;
    property OnGlyphChange: TNotifyEvent read FOnGlyphChange write FOnGlyphChange;
  end;

  {--Fancy button--}
  TDsFancyButton = class(TGraphicControl)
  private
    FEffect: TDsEffect;
    FGlyphs: TDsGlyph;
    FIsDown: Boolean;
    FInRegion: Boolean;
    FBmpWidth: Integer;
    FGlyphToDraw: Integer;
    FGlyphL, FGlyphT: Integer;
    FTransparentColor: TColor;
    FTextL, FTextT: Integer;

    procedure CMMouseLeave(var AMsg: TMessage); message CM_MOUSELEAVE;
    procedure CMEnabledChanged(var message: TMessage);
              message CM_ENABLEDCHANGED;
    procedure CMTextChanged(var message: TMessage);
              message CM_TEXTCHANGED;
    procedure CMDialogChar(var message: TCMDialogChar);
              message CM_DIALOGCHAR;
    procedure WMSize(var message: TWMSize); message WM_PAINT;
    procedure UpdateChanges(Sender: TObject);
  protected
    procedure Click; override;
    procedure DrawShape;
    procedure DrawShapePressed;
    procedure DrawButtonArea;
    procedure DrawGlyph;
    procedure WriteCaption;
    procedure LayoutSetting;
    procedure Paint; override;
    function  IsInRegion(X, Y: Integer): Boolean;
    function  ColorBlend(BaseColor, MixColor: TColor; Level: Byte): TColor;
    procedure Additional3DEffect;
    procedure MouseUp(Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton;
              Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    {$IFDEF Delphi5}
    property Anchors;
    property Constraints;
    {$ENDIF}

    property Caption;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FancyEffects: TDsEffect read FEffect write FEffect;
    property Glyphs: TDsGlyph read FGlyphs write FGlyphs;
    property Font;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;

    property OnClick;         property OnDragDrop;
    property OnDragOver;      property OnEndDrag;
    property OnMouseDown;     property OnMouseUp;
    property OnMouseMove;
  end;

procedure Register;

implementation

{----------------------------}
{--Fancy Options-------------}
{----------------------------}

procedure TDsEffect.SetButtonColor(Value: TColor);
begin
  if value<>FButtonColor then
    begin FButtonColor:=Value; DoChanges; end;
end;

procedure TDsEffect.SetFrameColor(Value: TColor);
begin
  if Value<>FFrameColor then
    begin FFrameColor:=Value; DoChanges; end;
end;

procedure TDsEffect.SetHoverColor(Value: TColor);
begin
  if Value<>FHoverColor then
    begin FHoverColor:=Value; DoChanges; end;
end;

procedure TDsEffect.SetBtnShape(Value: TBtnShape);
begin
  if Value<>FBtnShape then
    begin FBtnShape:=Value; DoChanges; end;
end;

procedure TDsEffect.SetCornerRadius(Value: Integer);
begin
  if Value<>FCornerRadius then
  begin
    FCornerRadius:=Value;
    if FCornerRadius<0 then FCornerRadius:=0;
    if FCornerRadius>145 then FCornerRadius:=145;
    DoChanges;
  end;
end;

procedure TDsEffect.SetFrameWidth(Value: Integer);
begin
  if Value<>FFrameWidth then
  begin
    FFrameWidth:=Value;
    if FFrameWidth<3 then FFrameWidth:=3;
    if FFrameWidth>14 then FFrameWidth:=14;
    DoChanges;
  end;
end;

procedure TDsEffect.SetTextStyle(Value: TTextStyle);
begin
  if Value<>FTextStyle then
    begin FTextStyle:=Value; DoChanges; end;
end;

procedure TDsEffect.SetFrameStyle(Value: TFrameStyle);
begin
  if Value<>FFrameStyle then
    begin FFrameStyle:=Value; DoChanges; end;
end;

procedure TDsEffect.DoChanges;
begin
  if Assigned(FOnEffectChange) then FOnEffectChange(Self);
end;


{----------------------------}
{--Glyph Options-------------}
{----------------------------}
procedure TDsGlyph.SetBmpGlyph(ABmpGlyph: TBitmap);
begin
  FBmpGlyph.Assign(ABmpGlyph);
  DoChanges;
end;

procedure TDsGlyph.SetBmpLayout(Value: TBmpLayout);
begin
  if Value<>FBmpLayout then
  begin
    FBmpLayout:=Value;
    DoChanges;
  end;
end;

procedure TDsGlyph.SetGlyphsNum(Value: Byte);
begin
  if Value<>FGlyphsNum then
  begin
    FGlyphsNum:=Value;
    if FGlyphsNum<1 then FGlyphsNum:=1;
    if FGlyphsNum>4 then FGlyphsNum:=4;
    DoChanges;
  end;
end;

procedure TDsGlyph.SetGlyphSpace(Value: Integer);
begin
  if Value<>FGlyphSpace then
  begin
    FGlyphSpace:=Value;
    if FGlyphSpace<1 then FGlyphSpace:=0;
    DoChanges;
  end;
end;

procedure TDsGlyph.DoChanges;
begin
  if Assigned(FOnGlyphChange) then FOnGlyphChange(Self);
end;


{----------------------------}
{--Fancy Button--------------}
{----------------------------}
constructor TDsFancyButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle:=[csClickEvents, csCaptureMouse, csSetCaption];
  Enabled:=True;
  
  FEffect:=TDsEffect.Create;
  with FEffect do
  begin
    FaceColor:=clBtnFace;
    FrameColor:=clGray;
    FFrameWidth:=4;
    FHoverColor:=clBlue;
    FBtnShape:=btnRectangle;
    FCornerRadius:=6;
    FTextStyle:=txLowered;
    FFrameStyle:=fmGradient;
    OnEffectChange:=UpdateChanges;
  end;

  FGlyphs:=TDsGlyph.Create;
  with FGlyphs do
  begin
    FBmpGlyph:=TBitmap.Create;
    FBmpLayout:=lyLeft;
    FGlyphsNum:=1;
    FGlyphSpace:=0;
    OnGlyphChange:=UpdateChanges;
  end;

  FBmpWidth:=0;
  FGlyphToDraw:=1;
  FIsDown:=False;
  Height:=25;
  Visible:=True;
  Width:=97;
end;

destructor TDsFancyButton.Destroy;
begin
  if Assigned(FGlyphs.Glyph) then FGlyphs.Glyph.Destroy;
  FGlyphs.Free;
  FEffect.Free;
  inherited Destroy;
end;

procedure TDsFancyButton.Paint;
var Dia: Integer;
begin
  FBmpWidth:=FGlyphs.Glyph.Width div FGlyphs.Number;

  Canvas.Font:=Self.Font;

  {--draw base color--}
  if FEffect.FFrameStyle=fmGradient then
  begin
    Canvas.Brush.Color:=ColorBlend(FEffect.FrameColor, Color, 80);
    Canvas.Pen.Color:=ColorBlend(FEffect.FrameColor, Color, 80);
    case FEffect.Shape of
      btnOval:
         Canvas.Ellipse(0, 0, Width, Height);
      btnCapsule:
         begin
           if Width<Height then Dia:=Width else Dia:=Height;
           Canvas.RoundRect(0, 0, Width, Height, Dia, Dia)
         end;
      btnRectangle:
         begin
           Dia:=2*FEffect.FCornerRadius;
           Canvas.RoundRect(0, 0, Width, Height, Dia, Dia);
         end;
    end
  end;

  Canvas.Brush.Style:=bsClear;
  if FEffect.FrameStyle=fmNone then DrawButtonArea
  else if FIsDown then DrawShapePressed
  else DrawShape;

  LayoutSetting;
  if FBmpWidth>0 then DrawGlyph;

  WriteCaption;
end;

function TDsFancyButton.IsInRegion(X, Y: Integer): Boolean;
var Dia: Integer;
    MRgn: HRgn;
begin
  Result:=False;
  case FEffect.Shape of
    btnRectangle:
      begin
        Dia:=2*FEffect.CornerRadius;