{*****************************************************}
{                                                     }
{     Varian Component Workshop                       }
{                                                     }
{     Varian Software NL (c) 1996-2000                }
{     All Rights Reserved                             }
{                                                     }
{*****************************************************}

unit VrButtons;

{$I VRLIB.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  VrTypes, VrClasses, VrControls, VrSysUtils;

type
  TVrHyperButton = class(TVrHyperlinkControl)
  private
    FGlyph: TBitmap;
    FBorderColor: TColor;
    FBorderHighlight: TColor;
    FBorderShadow: TColor;
    FColorEnter: TColor;
    FColorLeave: TColor;
    FSpacing: Integer;
    FMargin: Integer;
    FLayout: TVrImageTextLayout;
    FDisabledText: TColor;
    FDisabledAnimate: Boolean;
    FSize: TPoint;
    FImageRect: TRect;
    FTextBounds: TRect;
    FHasMouse: Boolean;
    FDown: Boolean;
    FPressed: Boolean;
    procedure SetGlyph(Value: TBitmap);
    procedure SetBorderColor(Value: TColor);
    procedure SetBorderHighlight(Value: TColor);
    procedure SetBorderShadow(Value: TColor);
    procedure SetColorEnter(Value: TColor);
    procedure SetColorLeave(Value: TColor);
    procedure SetLayout(Value: TVrImageTextLayout);
    procedure SetMargin(Value: Integer);
    procedure SetSpacing(Value: Integer);
    procedure GlyphChanged(Sender: TObject);
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  protected
    procedure Paint; override;
    procedure Click; override;
    procedure CalcPaintParams;
    function GetPalette: HPalette; override;
    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property BorderColor: TColor read FBorderColor write SetBorderColor;
    property BorderHighlight: TColor read FBorderHighlight write SetBorderHighlight;
    property BorderShadow: TColor read FBorderShadow write SetBorderShadow;
    property ColorEnter: TColor read FColorEnter write SetColorEnter;
    property ColorLeave: TColor read FColorLeave write SetColorLeave;
    property Layout: TVrImageTextLayout read FLayout write SetLayout default ImageLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property Spacing: Integer read FSpacing write SetSpacing default 5;
    property DisabledText: TColor read FDisabledText write FDisabledText default clInActiveCaption;
    property DisabledAnimate: Boolean read FDisabledAnimate write FDisabledAnimate default True;
    property Transparent;
    property OnMouseEnter;
    property OnMouseLeave;
{$IFDEF VER110}
    property Anchors;
    property Constraints;
{$ENDIF}
    property Caption;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Enabled;
    property Font;
    property ParentFont default false;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;

  TVrShadowButtonStyle = (ssRectangle, ssRoundRect);
  TVrShadowDirection = (sdTopLeft, sdTopRight, sdBottomLeft, sdBottomRight);

  TVrShadowBrush = class(TBrush)
  public
    constructor Create;
  published
    property Color default clBlack;
  end;

  TVrShadowPen = class(TPen)
  public
    constructor Create;
  published
    property Color default clLime;
  end;

  TVrShadowButton = class(TVrGraphicImageControl)
  private
    FDepth: Integer;
    FShadowColor: TColor;
    FShadowOutline: TColor;
    FBrush: TVrShadowBrush;
    FPen: TVrShadowPen;
    FStyle: TVrShadowButtonStyle;
    FDirection: TVrShadowDirection;
    FTextAlign: TVrTextAlignment;
    Down: Boolean;
    Pressed: Boolean;
    CurrentRect: TRect;
    procedure SetBrush(Value: TVrShadowBrush);
    procedure SetPen(Value: TVrShadowPen);
    procedure SetDepth(Value: Integer);
    procedure SetShadowColor(Value: TColor);
    procedure SetShadowOutline(Value: TColor);
    procedure SetStyle(Value: TVrShadowButtonStyle);
    procedure SetDirection(Value: TVrShadowDirection);
    procedure SetTextAlign(Value: TVrTextAlignment);
    procedure StyleChanged(Sender: TObject);
    procedure AdjustBtnRect(var Rect: TRect; Offset: Integer);
    procedure DoMouseDown(XPos, YPos: Integer);
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LButtonDown;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MouseMove;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LButtonUp;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LButtonDblClk;
  protected
    procedure DrawButton;
    procedure Paint; override;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Brush: TVrShadowBrush read FBrush write SetBrush;
    property Pen: TVrShadowPen read FPen write SetPen;
    property Depth: Integer read FDepth write SetDepth default 4;
    property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
    property ShadowOutline: TColor read FShadowOutline write SetShadowOutline default clBtnShadow;
    property Style: TVrShadowButtonStyle read FStyle write SetStyle default ssRoundRect;
    property Direction: TVrShadowDirection read FDirection write SetDirection default sdBottomRight;
    property TextAlign: TVrTextAlignment read FTextAlign write SetTextAlign default vtaCenter;
    property Transparent default false;
{$IFDEF VER110}
    property Anchors;
    property BiDiMode;
    property Constraints;
{$ENDIF}
    property Caption;
    property Color;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Enabled;
    property Font;
{$IFDEF VER110}
    property ParentBiDiMode;
{$ENDIF}
    property ParentColor default true;
    property ParentFont default false;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;

  TVrDemoButton = class(TVrCustomImageControl)
  private
    FBitmap: TBitmap;
    FFontEnter: TFont;
    FFontLeave: TFont;
    FBevelWidth: TVrByteInt;
    FOutlineWidth: Integer;
    FOutlineColor: TColor;
    FShadowColor: TColor;
    FHighlightColor: TColor;
    FFocusColor: TColor;
    FTextAlignment: TVrTextAlignment;
    FDisabledTextColor: TColor;
    FFont3D: TVrFont3D;
    FHasMouse: Boolean;
    FFocused: Boolean;
    Down: Boolean;
    Pressed: Boolean;
    procedure SetBitmap(Value: TBitmap);
    procedure SetFontEnter(Value: TFont);
    procedure SetFontLeave(Value: TFont);
    procedure SetOutlineColor(Value: TColor);
    procedure SetShadowColor(Value: TColor);
    procedure SetHighlightColor(Value: TColor);
    procedure SetBevelWidth(Value: TVrByteInt);
    procedure SetOutlineWidth(Value: Integer);
    procedure SetTextAlignment(Value: TVrTextAlignment);
    procedure SetDisabledTextColor(Value: TColor);
    procedure SetFocusColor(Value: TColor);
    procedure SetFont3D(Value: TVrFont3D);
    procedure FontChanged(Sender: TObject);
    procedure BitmapChanged(Sender: TObject);
    procedure DoMouseDown(XPos, YPos: Integer);
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LButtonDown;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MouseMove;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LButtonUp;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LButtonDblClk;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
  protected
    procedure Paint; override;
    function GetPalette: HPalette; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property FontEnter: TFont read FFontEnter write SetFontEnter;
    property FontLeave: TFont read FFontLeave write SetFontLeave;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property OutlineColor: TColor read FOutlineColor write SetOutlineColor default clBlack;
    property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
    property HighlightColor: TColor read FHighlightColor write SetHighlightColor default clBtnHighlight;
    property BevelWidth: TVrByteInt read FBevelWidth write SetBevelWidth default 2;
    property OutlineWidth: Integer read FOutlineWidth write SetOutlineWidth default 1;
    property TextAlignment: TVrTextAlignment read FTextAlignment write SetTextAlignment default vtaCenter;
    property DisabledTextColor: TColor read FDisabledTextColor write SetDisabledTextColor default clInActiveCaption;
    property FocusColor: TColor read FFocusColor write SetFocusColor default clBlue;
    property Font3D: TVrFont3D read FFont3D write SetFont3D;
{$IFDEF VER110}
    property Anchors;
    property BiDiMode;
    property Constraints;
{$ENDIF}
    property Caption;
    property Color default clBtnFace;
    property DragCursor;
{$IFDEF VER110}
    property DragKind;
{$ENDIF}
    property DragMode;
    property Enabled;
{$IFDEF VER110}
    property ParentBiDiMode;
{$ENDIF}
    property ParentColor default false;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default false;
    property Visible;
    property OnClick;
{$IFDEF VER130}
    property OnContextPopup;
{$ENDIF}
    property OnDragDrop;
    property OnDragOver;
{$IFDEF VER110}
    property OnEndDock;
{$ENDIF}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFDEF VER110}
    property OnStartDock;
{$ENDIF}
    property OnStartDrag;
  end;



implementation


{ TVrHyperButton }

constructor TVrHyperButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Controlstyle := Controlstyle + [csOpaque, csSetCaption] - [csDoubleClicks];
  Width := 100;
  Height := 25;
  FBorderColor := clGray;
  FBorderHighlight := clWindow;
  FBorderShadow := clBlack;
  FColorEnter := $000ABED8;
  FColorLeave := clBtnFace;
  FDisabledText := clInActiveCaption;
  FDisabledAnimate := True;
  FSpacing := 5;
  FMargin := -1;
  FLayout := ImageLeft;
  FGlyph := TBitmap.Create;
  FGlyph.OnChange := GlyphChanged;
end;

destructor TVrHyperButton.Destroy;
begin
  FGlyph.Free;
  inherited Destroy;
end;

function TVrHyperButton.GetPalette: HPalette;
begin
  if FGlyph.Empty then Result := inherited GetPalette
  else Result := FGlyph.Palette;
end;

procedure TVrHyperButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  UpdateControlCanvas;
end;

procedure TVrHyperButton.Paint;
var
  PaintRect: TRect;
  Animate: Boolean;
begin
  CalcPaintParams;
  ClearBitmapCanvas;
  Animate := (Enabled) or ((not Enabled) and DisabledAnimate);
  if (FHasMouse and Animate) then
  begin
    BitmapCanvas.Pen.Color := ColorEnter;
    BitmapCanvas.Brush.Color := ColorEnter;
    BitmapCanvas.Brush.Style := bsSolid;
  end
  else
  begin
    BitmapCanvas.Pen.Color := BorderColor;
    BitmapCanvas.Brush.Color := ColorLeave;
    BitmapCanvas.Brush.Style := bsClear;
  end;
  BitmapCanvas.Rectangle(0, 0, Width, Height);

  PaintRect := ClientRect;
  if (FHasMouse and Animate) or FPressed then
  begin
    if not FPressed then
      DrawFrame3D(BitmapCanvas, PaintRect,