Delphi控件源码

开发平台：
Delphi

VrButtons.pas：源码内容
							{*****************************************************}
{                                                     }
{     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,
        BorderHighlight, BorderShadow, 1)
    else
      DrawFrame3D(BitmapCanvas, PaintRect,
        BorderShadow, BorderHighlight, 1)
  end else InflateRect(PaintRect, -1, -1);
  if FPressed then
  begin
    OffsetRect(FImageRect, 1, 1);
    OffsetRect(FTextBounds, 1, 1);
  end;
  if not FGlyph.Empty then
  begin
    BitmapCanvas.Brush.Style := bsClear;
    BitmapCanvas.BrushCopy(FImageRect, FGlyph, BitmapRect(FGlyph),
      FGlyph.TransparentColor);
  end;
  if not Enabled then
    BitmapCanvas.Font.Color := DisabledText;
  BitmapCanvas.Brush.Style := bsClear;
  DrawText(BitmapCanvas.Handle, PChar(Caption), -1, FTextBounds,
    DT_SINGLELINE + DT_VCENTER + DT_CENTER);
  inherited Paint;
end;
procedure TVrHyperButton.CalcPaintParams;
var
  Rect: TRect;
  ImagePos: TPoint;
begin
  Rect := ClientRect;
  InflateRect(Rect, -1, -1); //fix borderwidth
  FSize.X := FGlyph.Width;
  FSize.Y := FGlyph.Height;
  BitmapCanvas.Font.Assign(Self.Font);
  CalcImageTextLayout(BitmapCanvas, Rect, Point(1, 1), Caption, FLayout,
    FMargin, FSpacing, Point(FSize.X, FSize.Y), ImagePos, FTextBounds);
  if FGlyph.Empty then OffsetRect(FTextBounds, 0, -1);
  FImageRect := Bounds(ImagePos.X, ImagePos.Y, FSize.X, FSize.Y);
end;
procedure TVrHyperButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  BitmapCanvas.Font.Assign(Self.Font);
  UpdateControlCanvas;
end;
procedure TVrHyperButton.CMEnabledChanged(var Message: TMessage);
begin
  UpdateControlCanvas;
end;
procedure TVrHyperButton.GlyphChanged(Sender: TObject);
begin
  UpdateControlCanvas;
end;
procedure TVrHyperButton.SetLayout(Value: TVrImageTextLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrHyperButton.SetMargin(Value: Integer);
begin
  if FMargin <> Value then
  begin
    FMargin := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrHyperButton.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrHyperButton.SetBorderColor(Value: TColor);
begin
  if FBorderColor <> Value then
  begin
    FBorderColor := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrHyperButton.SetBorderHighlight(Value: TColor);
begin
  if FBorderHighlight <> Value then
  begin
    FBorderHighlight := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrHyperButton.SetBorderShadow(Value: TColor);
begin
  if FBorderShadow <> Value then
  begin
    FBorderShadow := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrHyperButton.SetColorEnter(Value: TColor);
begin
  if FColorEnter <> Value then
  begin
    FColorEnter := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrHyperButton.SetColorLeave(Value: TColor);
begin
  if FColorLeave <> Value then
  begin
    FColorLeave := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrHyperButton.SetGlyph(Value: TBitmap);
begin
  FGlyph.Assign(Value);
end;
procedure TVrHyperButton.Click;
begin
end;
procedure TVrHyperButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if (Button = mbLeft) then
  begin
    FDown := True;
    FPressed := True;
    UpdateControlCanvas;
  end;
  inherited MouseDown(Button, Shift, X, Y);
end;
procedure TVrHyperButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  FDown := false;
  DoClick := false;
  if FPressed then
  begin
    FPressed := false;
    UpdateControlCanvas;
    DoClick := True;
  end;
  inherited MouseUp(Button, Shift, X, Y);
  if DoClick then
    inherited Click;
end;
procedure TVrHyperButton.MouseEnter;
begin
  FHasMouse := True;
  if FDown then FPressed := True;
  UpdateControlCanvas;
  inherited;
end;
procedure TVrHyperButton.MouseLeave;
begin
  FHasMouse := false;
  if FDown then FPressed := false;
  UpdateControlCanvas;
  inherited;
end;
{ TVrShadowBrush }
constructor TVrShadowBrush.Create;
begin
  inherited Create;
  Color := clBlack;
end;
{ TVrShadowPen }
constructor TVrShadowPen.Create;
begin
  inherited Create;
  Color := clLime;
end;
{TVrShadowButton}
constructor TVrShadowButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque] - [csDoubleClicks];
  Width := 110;
  Height := 30;
  Font.Color := clWhite;
  ParentColor := true;
  ParentFont := false;
  FDepth := 4;
  FShadowColor := clBtnShadow;
  FShadowOutline := clBtnShadow;
  FBrush := TVrShadowBrush.Create;
  FBrush.OnChange := StyleChanged;
  FPen := TVrShadowPen.Create;
  FPen.OnChange := StyleChanged;
  FStyle := ssRoundRect;
  FDirection := sdBottomRight;
  FTextAlign := vtaCenter;
end;
destructor TVrShadowButton.Destroy;
begin
  FBrush.Free;
  FPen.Free;
  inherited Destroy;
end;
procedure TVrshadowButton.Click;
begin
end;
procedure TVrShadowButton.SetBrush(Value: TVrShadowBrush);
begin
  FBrush.Assign(Value);
end;
procedure TVrShadowButton.SetPen(Value: TVrShadowPen);
begin
  FPen.Assign(Value);
end;
procedure TVrShadowButton.SetDepth(Value: Integer);
begin
  if (FDepth <> Value) and (Value > 2) then
  begin
    FDepth := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrShadowButton.SetShadowColor(Value: TColor);
begin
  if FShadowColor <> Value then
  begin
    FShadowColor := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrShadowButton.SetShadowOutline(Value: TColor);
begin
  if FShadowOutline <> Value then
  begin
    FShadowOutline := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrShadowButton.SetStyle(Value: TVrShadowButtonStyle);
begin
  if FStyle <> Value then
  begin
    FStyle := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrShadowButton.SetDirection(Value: TVrShadowDirection);
begin
  if FDirection <> Value then
  begin
    FDirection := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrShadowButton.SetTextAlign(Value: TVrTextAlignment);
begin
  if FTextAlign <> Value then
  begin
    FTextAlign := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrShadowButton.StyleChanged(Sender: TObject);
begin
  UpdateControlCanvas;
end;
procedure TVrShadowButton.AdjustBtnRect(var Rect: TRect; Offset: Integer);
begin
  case FDirection of
    sdBottomRight: OffsetRect(Rect, Offset, Offset);
    sdBottomLeft: OffsetRect(Rect, -Offset, Offset);
    sdTopLeft: OffsetRect(Rect, -Offset, -Offset);
    sdTopRight: OffsetRect(Rect, Offset, -Offset);
  end;
end;
procedure TVrShadowButton.DrawButton;
const
  ShapeStyles: array[TVrShadowButtonStyle] of TVrShapeType =
    (stRectangle, stRoundRect);
var
  ImageRect, ShadowRect: TRect;
begin
  ImageRect := ClientRect;
  with BitmapImage do
  begin
    InflateRect(ImageRect, -FPen.Width, -FPen.Width);
    case FDirection of
      sdBottomRight:
        begin
          Dec(ImageRect.Right, FDepth);
          Dec(ImageRect.Bottom, FDepth);
        end;
      sdBottomLeft:
        begin
          Inc(ImageRect.Left, FDepth);
          Dec(ImageRect.Bottom, FDepth);
        end;
      sdTopLeft:
        begin
          Inc(ImageRect.Top, FDepth);
          Inc(ImageRect.Left, FDepth);
        end;
      sdTopRight:
        begin
          Inc(ImageRect.Top, FDepth);
          Dec(ImageRect.Right, FDepth);
        end;
    end;
    with Canvas do
    begin
      Pen.Width := 1;
      Pen.Color := FShadowOutline;
      Pen.Mode := pmCopy;
      Pen.Style := psSolid;
      Brush.Style := bsSolid;
      Brush.Color := FShadowColor;
    end;
    ShadowRect := ImageRect;
    AdjustBtnRect(ShadowRect, FDepth);
    if Down then
      AdjustBtnRect(ShadowRect, -1);
    DrawShape(Canvas, ShapeStyles[FStyle], ShadowRect.Left, ShadowRect.Top,
        ShadowRect.Right - ShadowRect.Left, ShadowRect.Bottom - ShadowRect.Top);
    if Down then AdjustBtnRect(ImageRect, 2);
    Canvas.Brush.Assign(FBrush);
    Canvas.Pen.Assign(FPen);
    Canvas.Font.Assign(Self.Font);
    if not Enabled then Canvas.Font.Color := clInActiveCaption;
    DrawShape(Canvas, ShapeStyles[FStyle], ImageRect.Left, ImageRect.Top,
      ImageRect.Right - ImageRect.Left, ImageRect.Bottom - ImageRect.Top);
    InflateRect(ImageRect, -Pen.Width, -Pen.Width);
    Canvas.Brush.Style := bsClear;
    DrawText(Canvas.Handle, PChar(Caption), -1, ImageRect,
      DT_SINGLELINE + VrTextAlign[TextAlign]);
    CurrentRect := ImageRect;
  end;
end;
procedure TVrShadowButton.Paint;
begin
  ClearBitmapCanvas;
  DrawButton;
  inherited Paint;
end;
procedure TVrShadowButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  UpdateControlCanvas;
end;
procedure TVrShadowButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  BitmapCanvas.Font.Assign(Self.Font);
  UpdateControlCanvas;
end;
procedure TVrShadowButton.DoMouseDown(XPos, YPos: Integer);
var
  P: TPoint;
begin
  P := Point(XPos, YPos);
  if PtInRect(CurrentRect, P) then
  begin
    Pressed := True;
    Down := True;
    MouseCapture := true;
    UpdateControlCanvas;
  end;
end;
procedure TVrShadowButton.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  DoMouseDown(Message.XPos, Message.YPos);
end;
procedure TVrShadowButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  inherited;
  DoMouseDown(Message.XPos, Message.YPos);
end;
procedure TVrShadowButton.WMMouseMove(var Message: TWMMouseMove);
var
  P: TPoint;
begin
  inherited;
  if Pressed then
  begin
    P := Point(Message.XPos, Message.YPos);
    if PtInRect(CurrentRect, P) <> Down then
    begin
      Down := not Down;
      UpdateControlCanvas;
    end;
  end;
end;
procedure TVrShadowButton.WMLButtonUp(var Message: TWMLButtonUp);
var
  DoClick: Boolean;
begin
  MouseCapture := false;
  DoClick := Pressed and Down;
  Down := false;
  Pressed := false;
  if DoClick then
  begin
    UpdateControlCanvas;
    inherited Click;
  end;
  inherited;
end;
procedure TVrShadowButton.CMDialogChar(var Message: TCMDialogChar);
begin
  if Enabled and IsAccel(Message.CharCode, Caption) then
    inherited Click;
end;
procedure TVrShadowButton.CMEnabledChanged(var Message: TMessage);
begin
  UpdateControlCanvas;
end;
{ TVrDemoButton }
constructor TVrDemoButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque] - [csDoubleClicks];
  Width := 150;
  Height := 25;
  Color := clBtnFace;
  ParentColor := false;
  FBitmap := TBitmap.Create;
  FBitmap.OnChange := BitmapChanged;
  FFont3D := TVrFont3D.Create;
  FFont3D.OnChange := FontChanged;
  FFontEnter := TFont.Create;
  with FFontEnter do
  begin
    Name := 'Arial';
    Size := 12;
    Color := clRed;
    Style := Style + [fsBold];
    OnChange := FontChanged;
  end;
  FFontLeave := TFont.Create;
  with FFontLeave do
  begin
    Name := 'Arial';
    Size := 12;
    Color := clBlack;
    Style := Style + [fsBold];
    OnChange := FontChanged;
  end;
  FBevelWidth := 2;
  FOutlineWidth := 1;
  FShadowColor := clBtnShadow;
  FHighlightColor := clBtnHighlight;
  FOutlineColor := clBlack;
  FTextAlignment := vtaCenter;
  FDisabledTextColor := clInActiveCaption;
  FFocusColor := clBlue;
end;
destructor TVrDemoButton.Destroy;
begin
  FBitmap.Free;
  FFont3D.Free;
  FFontEnter.Free;
  FFontLeave.Free;
  inherited Destroy;
end;
procedure TVrDemoButton.FontChanged(Sender: TObject);
begin
  UpdateControlCanvas;
end;
procedure TVrDemoButton.BitmapChanged(Sender: TObject);
begin
  UpdateControlCanvas;
end;
function TVrDemoButton.GetPalette: HPalette;
begin
  if FBitmap.Empty then Result := inherited GetPalette
  else Result := FBitmap.Palette;
end;
procedure TVrDemoButton.Paint;
var
  R: TRect;
begin
  if FBitmap.Empty then ClearBitmapCanvas
  else
    begin
      R := ClientRect;
      if Down then OffsetRect(R, 1, 1);
      DrawTiledBitmap(BitmapCanvas, R, Bitmap);
    end;
  R := ClientRect;
  if FFocused then
    DrawFrame3D(BitmapCanvas, R, FocusColor, FocusColor, OutlineWidth)
  else DrawFrame3D(BitmapCanvas, R, OutlineColor, OutlineColor, OutlineWidth);
  if Down then
    DrawFrame3D(BitmapCanvas, R, ShadowColor, HighlightColor, BevelWidth)
  else DrawFrame3D(BitmapCanvas, R, HighlightColor, ShadowColor, BevelWidth);
  with BitmapCanvas do
  begin
    if FHasMouse and Enabled then
      Font.Assign(FontEnter)
    else Font.Assign(FontLeave);
    if not Enabled then
      Font.Color := DisabledTextColor;
    Brush.Style := bsClear;
    if Down then OffsetRect(R, 1, 1);
    FFont3D.Paint(BitmapCanvas, R, Caption,
      DT_SINGLELINE + VrTextAlign[TextAlignment]);
  end;
  inherited Paint;
end;
procedure TVrDemoButton.SetBitmap(Value: TBitmap);
begin
  FBitmap.Assign(Value);
end;
procedure TVrDemoButton.SetFontEnter(Value: TFont);
begin
  FFontEnter.Assign(Value);
end;
procedure TVrDemoButton.SetFontLeave(Value: TFont);
begin
  FFontLeave.Assign(Value);
end;
procedure TVrDemoButton.SetOutlineColor(Value: TColor);
begin
  if FOutlineColor <> Value then
  begin
    FOutlineColor := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.SetShadowColor(Value: TColor);
begin
  if FShadowColor <> Value then
  begin
    FShadowColor := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.SetHighlightColor(Value: TColor);
begin
  if FHighlightColor <> Value then
  begin
    FHighlightColor := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.SetBevelWidth(Value: TVrByteInt);
begin
  if FBevelWidth <> Value then
  begin
    FBevelWidth := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.SetOutlineWidth(Value: Integer);
begin
  if FOutlineWidth <> Value then
  begin
    FOutlineWidth := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.SetTextAlignment(Value: TVrTextAlignment);
begin
  if FTextAlignment <> Value then
  begin
    FTextAlignment := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.SetDisabledTextColor(Value: TColor);
begin
  if FDisabledTextColor <> Value then
  begin
    FDisabledTextColor := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.SetFocusColor(Value: TColor);
begin
  if FFocusColor <> Value then
  begin
    FFocusColor := Value;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.SetFont3D(Value: TVrFont3D);
begin
  FFont3D.Assign(Value);
end;
procedure TVrDemoButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  UpdateControlCanvas;
end;
procedure TVrDemoButton.DoMouseDown(XPos, YPos: Integer);
var
  P: TPoint;
begin
  P := Point(XPos, YPos);
  if PtInRect(ClientRect, P) then
  begin
    Pressed := True;
    Down := True;
    MouseCapture := true;
    if TabStop then SetFocus;
    UpdateControlCanvas;
  end;
end;
procedure TVrDemoButton.Click;
begin
end;
procedure TVrDemoButton.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  DoMouseDown(Message.XPos, Message.YPos);
end;
procedure TVrDemoButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  inherited;
  DoMouseDown(Message.XPos, Message.YPos);
end;
procedure TVrDemoButton.WMMouseMove(var Message: TWMMouseMove);
var
  P: TPoint;
begin
  inherited;
  if Pressed then
  begin
    P := Point(Message.XPos, Message.YPos);
    if PtInRect(ClientRect, P) <> Down then
    begin
      Down := not Down;
      UpdateControlCanvas;
    end;
  end;
end;
procedure TVrDemoButton.WMLButtonUp(var Message: TWMLButtonUp);
var
  DoClick: Boolean;
begin
  MouseCapture := false;
  DoClick := Pressed and Down;
  Down := false;
  Pressed := false;
  if DoClick then
  begin
    UpdateControlCanvas;
    inherited Click;
  end;
  inherited;
end;
procedure TVrDemoButton.CMDialogChar(var Message: TCMDialogChar);
begin
  if Enabled and IsAccel(Message.CharCode, Caption) then
    inherited Click;
end;
procedure TVrDemoButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  UpdateControlCanvas;
end;
procedure TVrDemoButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  FHasMouse := True;
  UpdateControlCanvas;
end;
procedure TVrDemoButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FHasMouse := false;
  UpdateControlCanvas;
end;
procedure TVrDemoButton.CMFocusChanged(var Message: TCMFocusChanged);
var
  Active: Boolean;
begin
  with Message do Active := (Sender = Self);
  if Active <> FFocused then
  begin
    FFocused := Active;
    UpdateControlCanvas;
  end;
  inherited;
end;
procedure TVrDemoButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (not Down) and (Key = VK_SPACE) then DoMouseDown(0, 0);
end;
procedure TVrDemoButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key, Shift);
  if Key = VK_SPACE then
  begin
    MouseCapture := false;
    if Pressed and Down then
    begin
      Down := False;
      UpdateControlCanvas;
      inherited Click;
    end;
    Pressed := False;
  end;
end;
end.

						