gifbutton.pas

透明按钮 透明按钮 透明按钮

unit GIFButton;
////////////////////////////////////////////////////////////////////////////////
//                                                                            //
// Project:	TGIFImage demo application.                                   //
// Description:	TBitBtn like component that displays GIFs instead of BMPs.    //
// Copyright	(c) 1997,98 Anders Melander.                                  //
//		All rights reserved.                                          //
// Formatting:	2 space indent, 8 space tabs, 80 columns.                     //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////
//                                                                            //
// This component is based on Inprise's TBitBtn component.                    //
// Portions Copyright (c) 1995,98 Inprise Corporation                         //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////
interface
{$ObjExportAll On}
uses
  StdCtrls, GIFimage, Buttons, ExtCtrls, Classes, Graphics, Windows, Messages,
  Controls;

type
  TGIFButton = class(TButton)
  private
    FCanvas: TCanvas;
    FCurrentGlyph: TGIFImage;
    FGlyph: TGIFImage;
    FGlyphMouseOver: TGIFImage;
    FStyle: TButtonStyle;
    FLayout: TButtonLayout;
    FSpacing: Integer;
    FMargin: Integer;
    IsFocused: Boolean;
    FModifiedGlyph: Boolean;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseExit: TNotifyEvent;
    FInsideButton: boolean;
    GlyphRect: TRect;
    AnimationUpdate: boolean;
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
    procedure SetGlyph(Index: integer; Value: TGIFImage);
    procedure GlyphChanged(Sender: TObject);
    procedure SetStyle(Value: TButtonStyle);
    procedure SetLayout(Value: TButtonLayout);
    procedure SetSpacing(Value: Integer);
    procedure SetMargin(Value: Integer);
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    function GetPalette: HPALETTE; override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure CMMouseEnter(var msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
    function DoDraw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
      const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
      State: TButtonState; Transparent: Boolean; BiDiFlags: Longint): TRect;
    procedure DrawButtonGlyph(Canvas: TCanvas; const GlyphRect: TRect);
    procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
      TextBounds: TRect; State: TButtonState; BiDiFlags: Longint);
    procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
      const Offset: TPoint; const Caption: string; Layout: TButtonLayout;
      Margin, Spacing: Integer; var GlyphRect: TRect; var TextBounds: TRect;
      BiDiFlags: Longint);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
{$IFDEF VER120}
    property Action;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property ParentBiDiMode;
{$ENDIF}
    property Cancel;
    property Caption;
    property Default;
    property Enabled;
    property Glyph: TGIFImage index 1 read FGlyph write SetGlyph;
    property GlyphMouseOver: TGIFImage index 2 read FGlyphMouseOver write SetGlyph;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property ModalResult;
    property ParentShowHint;
    property ShowHint;
    property Style: TButtonStyle read FStyle write SetStyle default bsAutoDetect;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnEnter;
    property OnExit;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit:  TNotifyEvent read FOnMouseExit  write FOnMouseExit;
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('MyButton', [TGIFButton]);
end;

constructor TGIFButton.Create(AOwner: TComponent);
begin
  FGlyph := TGIFImage.Create;
  FGlyph.DrawOptions :=
    FGlyph.DrawOptions - [goDirectDraw]+[goLoopContinously];
  if (csDesigning in ComponentState) then
    FGlyph.DrawOptions := FGlyph.DrawOptions - [goAnimate];
  FGlyph.OnChange := GlyphChanged;

  FGlyphMouseOver := TGIFImage.Create;
  FGlyphMouseOver.DrawOptions :=
    FGlyphMouseOver.DrawOptions - [goDirectDraw]+[goLoopContinously];
  FGlyphMouseOver.OnChange := GlyphChanged;

  FCurrentGlyph := FGlyph;

  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
  FStyle := bsAutoDetect;
  FLayout := blGlyphLeft;
  FSpacing := 4;
  FMargin := -1;
{$ifndef VER90}
  ControlStyle := ControlStyle + [csReflector];
{$endif}
  AnimationUpdate := False;
end;

destructor TGIFButton.Destroy;
begin
  if (Assigned(FCurrentGlyph)) then
    FCurrentGlyph.StopDraw;
  FGlyph.Free;
  FGlyphMouseOver.Free;
  FCanvas.Free;
  inherited Destroy;
end;

procedure TGIFButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TGIFButton.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> IsFocused then
  begin
    IsFocused := ADefault;
    Refresh;
  end;
end;

procedure TGIFButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth := Width;
    itemHeight := Height;
  end;
end;

procedure TGIFButton.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure TGIFButton.DrawButtonGlyph(Canvas: TCanvas; const GlyphRect: TRect);
begin
  if not(FCurrentGlyph.Empty) then
    Canvas.Draw(GlyphRect.Left, GlyphRect.Top, FCurrentGlyph);
  FModifiedGlyph := False;
end;

procedure TGIFButton.DrawButtonText(Canvas: TCanvas; const Caption: string;
  TextBounds: TRect; State: TButtonState; BiDiFlags: LongInt);
begin
  with Canvas do
  begin
    Brush.Style := bsClear;
    if State = bsDisabled then
    begin
      OffsetRect(TextBounds, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
        DT_CENTER or DT_VCENTER or BiDiFlags);
      OffsetRect(TextBounds, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
        DT_CENTER or DT_VCENTER or BiDiFlags);
    end else
      DrawText(Handle, PChar(Caption), Length(Caption), TextBounds,
        DT_CENTER or DT_VCENTER or BiDiFlags);
  end;
end;

procedure TGIFButton.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
  const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin,
  Spacing: Integer; var GlyphRect: TRect; var TextBounds: TRect;
  BiDiFlags: LongInt);
var
  TextPos: TPoint;
  ClientSize, TextSize: TPoint;
  TotalSize: TPoint;
begin
  if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
    if Layout = blGlyphLeft then Layout := blGlyphRight
    else
      if Layout = blGlyphRight then Layout := blGlyphLeft;
  { calculate the item sizes }
  ClientSize := Point(Client.Right - Client.Left, Client.Bottom -  Client.Top);

  GlyphRect := Rect(0,0, FCurrentGlyph.Width, FCurrentGlyph.Height);

  if Length(Caption) > 0 then
  begin
    TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
    DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds,
      DT_CALCRECT or BiDiFlags);
    TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
      TextBounds.Top);
  end else
  begin
    TextBounds := Rect(0, 0, 0, 0);
    TextSize := Point(0,0);
  end;

  { If the layout has the glyph on the right or the left, then both the
    text and the glyph are centered vertically.  If the glyph is on the top
    or the bottom, then both the text and the glyph are centered horizontally.}
  if Layout in [blGlyphLeft, blGlyphRight] then
  begin
    GlyphRect.Top := (ClientSize.Y - GlyphRect.Bottom + 1) div 2;
    TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  end
  else
  begin
    GlyphRect.Left := (ClientSize.X - GlyphRect.Right + 1) div 2;
    TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  end;

  { if there is no text or no bitmap, then Spacing is irrelevant }
  if (TextSize.X = 0) or (GlyphRect.Right = 0) then
    Spacing := 0;

  { adjust Margin and Spacing }
  if Margin = -1 then
  begin
    if Spacing = -1 then
    begin
      TotalSize := Point(GlyphRect.Right + TextSize.X, GlyphRect.Bottom + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then
        Margin := (ClientSize.X - TotalSize.X) div 3
      else
        Margin := (ClientSize.Y - TotalSize.Y) div 3;
      Spacing := Margin;
    end else
    begin
      TotalSize := Point(GlyphRect.Right + Spacing + TextSize.X,
        GlyphRect.Bottom + Spacing + TextSize.Y);
      if Layout in [blGlyphLeft, blGlyphRight] then
        Margin := (ClientSize.X - TotalSize.X + 1) div 2
      else
        Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
    end;
  end else
  begin