cdibbutton.pas

Delphi控件

unit cDIBButton;

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: cDIBButton.PAS, released August 28, 2000.

The Initial Developer of the Original Code is Peter Morris ([e-mail]),
Portions created by Peter Morris are Copyright (C) 2000 Peter Morris.
All Rights Reserved.

Purpose of file:
Animated buttons, may be used for Radio / checkboxes also

Contributor(s):
Sylane - [e-mail]
  Center property.
  Bug reports regarding timer being enabled when not needed.


Last Modified: March 23, 2003

You may retrieve the latest version of this file at http://www.droopyeyes.com


Known Issues:
-----------------------------------------------------------------------------}
//Modifications
(*
Date:   September 16, 2001
Found:  Simon S <[e-mail]>
By:     Peter Morris
Change: Click would repeat if the OnClick code invoked Application.ProcessMessages
        moved the "inherited Click;" command to the end of AnimEnd.

Date:   March 23, 2003
By:     Peter Morris
Change: Added AbstractDIBButton, used CanAutoResize

*)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  cDIBControl, cDIBImageList, cDIBAnimMgr, cDIB, cDIBTimer;

type
  EDIBButtonError = class(EDIBError);
  
  TButtonState = (bsEnabled, bsMouseClick, bsDisabled, bsMouseOver, bsDown);
  TCurrentAnim = (caNone, caDisabled, caEnabled, caMouseEnter, caMouseOver,
    caMouseClick, caMouseLeave, caDown);
  TAnimMethod = (amForward, amBackward, amPingPong);

  TAbstractDIBButton = class(TCustomDIBControl)
  private
    FButtonState: TButtonState;
    FGroup: Integer;
    FDown: Boolean;
    FToggleDown: Boolean;
    procedure SetGroup(const Value: Integer);
    procedure SetOthersUp;
  protected
    procedure Click; override;
    procedure DoMouseEnter; override;
    procedure DoMouseLeave; override;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure SetButtonState(Value: TButtonState); virtual;
    procedure SetDown(const Value: Boolean); virtual;
    procedure SetEnabled(Value: Boolean); override;
    procedure UpdateButtonState; virtual;

    property ButtonState: TButtonState read FButtonState write SetButtonState;
    property Down: Boolean read FDown write SetDown default False;
    property Group: Integer read FGroup write SetGroup default 0;
    property ToggleDown: Boolean read FToggleDown write FToggleDown;
  public
    constructor Create(AOwner: TComponent); override;
  published
  end;

  TCustomDIBButtonAnim = class(TPersistent)
  private
    FAnimationLink: TDIBAnimationLink;
    FAnimDir,
    FFrame: Integer;
    FAnimMethod: TAnimMethod;
    FFrameDelay: Word;
    FOnAnimEnd: TNotifyEvent;
    FOnAnimationChanged: TNotifyEvent;
    function GetImage(var TheDIB: TMemoryDIB): Boolean;
    procedure DoAnimationChanged(Sender: TObject);
    function GetAnimation: TDIBAnimation;
    procedure SetAnimation(const Value: TDIBAnimation);
  protected
    procedure Animate;
  public
    constructor Create(AOwner: TComponent); virtual;
    destructor Destroy; override;

    function GetDimensions: TPoint;
    procedure Reset;
    function Valid: Boolean;

    property OnAnimationChanged: TNotifyEvent 
      read FOnAnimationChanged write FOnAnimationChanged;

    property AnimMethod: TAnimMethod read FAnimMethod write FAnimMethod;
    property Animation: TDIBAnimation read GetAnimation write SetAnimation;
    property FrameDelay: Word read FFrameDelay write FFrameDelay;
  published
  end;

  TDIBButtonAnim = class(TCustomDIBButtonAnim)
  published
    property AnimMethod;
    property Animation;
    property FrameDelay;
  end;

  TCustomDIBButton = class(TAbstractDIBButton)
  private
    { Private declarations }
    FAnimPic,
    FAnimEnabled,
    FAnimDisabled,
    FAnimMouseEnter,
    FAnimMouseOver,
    FAnimMouseClick,
    FAnimDown,
    FAnimMouseLeave: TDIBButtonAnim;
    FCenter: Boolean;
    FCurrentAnim: TCurrentAnim;
    FTimer: TDIBTimer;

    procedure SetAnimPic(const Value: TDIBButtonAnim);
    procedure SetCurrentAnim(const Value: TCurrentAnim);

    property AnimPic: TDIBButtonAnim read FAnimPic write SetAnimPic;
    property CurrentAnim: TCurrentAnim read FCurrentAnim write SetCurrentAnim;

    procedure DoAnimationChanged(Sender: TObject);
    procedure DoAnimEnd(Sender: TObject);
    procedure DoTimer(Sender: TObject);
  protected
    { Protected declarations }
    procedure Animate; virtual;
    procedure AnimationChanged; virtual;
    procedure AnimEnd; virtual;
    function CanAutoSize(var NewWidth: Integer; var NewHeight: Integer): Boolean; override;
    procedure DoAnyEnter; override;
    procedure DoAnyLeave; override;
    procedure Loaded; override;
    procedure Paint; override;
    procedure SetCenter(const Value: Boolean);
    procedure SetEnabled(Value: Boolean); override;
    procedure SetDown(const Value: Boolean); override;

    property AnimEnabled: TDIBButtonAnim read FAnimEnabled write FAnimEnabled;
    property AnimDown: TDIBButtonAnim read FAnimDown write FAnimDown;
    property AnimDisabled: TDIBButtonAnim read FAnimDisabled write FAnimDisabled;
    property AnimMouseEnter: TDIBButtonAnim read FAnimMouseEnter write FAnimMouseEnter;
    property AnimMouseOver: TDIBButtonAnim read FAnimMouseOver write FAnimMouseOver;
    property AnimMouseClick: TDIBButtonAnim read FAnimMouseClick write FAnimMouseClick;
    property AnimMouseLeave: TDIBButtonAnim read FAnimMouseLeave write FAnimMouseLeave;

    property Center: Boolean read FCenter write SetCenter;
    property Down: Boolean read FDown write SetDown;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
  published
    { Published declarations }
  end;

  TDIBButton = class(TCustomDIBButton)
  private

  protected
  public
  published
    property AnimEnabled;
    property AnimDown;
    property AnimDisabled;
    property AnimMouseEnter;
    property AnimMouseOver;
    property AnimMouseClick;
    property AnimMouseLeave;
    property AutoSize;
    property Center;
    property DIBFeatures;
    property DIBTabOrder;
    property Down;
    property Group;
    property Opacity;
    property ToggleDown;

    {$I WINControlEvents.inc}
    property OnClick;
    property OnMouseEnter;
    property OnMouseLeave;
  end;


implementation

{ TAbstractDIBButton }

procedure TAbstractDIBButton.Click;
begin
  inherited;
  if ToggleDown then
    Down := not Down;
end;

constructor TAbstractDIBButton.Create(AOwner: TComponent);
begin
  inherited;
  FDown := False;
  FGroup := 0;
  FToggleDown := False;
end;

procedure TAbstractDIBButton.DoMouseEnter;
begin
  inherited;
  UpdateButtonState;
end;

procedure TAbstractDIBButton.DoMouseLeave;
begin
  inherited;
  UpdateButtonState;
end;

procedure TAbstractDIBButton.Loaded;
begin
  inherited;
  UpdateButtonState;
end;

procedure TAbstractDIBButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button = mbLeft then
    UpdateButtonState;
end;

procedure TAbstractDIBButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  if Button = mbLeft then
    UpdateButtonState;
end;

procedure TAbstractDIBButton.SetButtonState(Value: TButtonState);
begin
  if Value <> FButtonState then
  begin
    FButtonState := Value;
    Changed;
  end;
end;

procedure TAbstractDIBButton.SetDown(const Value: Boolean);
begin
  FDown := Value;
  UpdateButtonState;
  if Down then
    SetOthersUp;
end;

procedure TAbstractDIBButton.SetEnabled(Value: Boolean);
begin
  inherited;
  UpdateButtonState;
end;

procedure TAbstractDIBButton.SetGroup(const Value: Integer);
begin
  if Group < 0 then
    raise EDIBButtonError.Create('Invalid group.');
  FGroup := Value;
  if (Value > 0) and Down then
    SetOthersUp;
end;

procedure TAbstractDIBButton.SetOthersUp;
var
  X: Integer;
begin
  if Owner = nil then exit;
  if Group = 0 then exit;

  for X := 0 to Owner.ComponentCount - 1 do
    if Owner.Components[X] is TAbstractDIBButton then
      if Owner.Components[X] <> Self then
        with TAbstractDIBButton(Owner.Components[X]) do
          if (Group = Self.Group) and Down then
            Down := False;
end;

procedure TAbstractDIBButton.UpdateButtonState;
begin
  if not Enabled then
    ButtonState := bsDisabled
  else
  if Down then
    ButtonState := bsDown
  else
  if MouseOver or Focused then
  begin
    if mbLeft in MouseButtons then
      ButtonState := bsMouseClick
    else
      ButtonState := bsMouseOver;
  end else
    ButtonState := bsEnabled;
  Invalidate;
end;

{ TCustomDIBButtonAnim }

procedure TCustomDIBButtonAnim.Animate;
begin
  if not Animation.Valid then
  begin
    if Assigned(FOnAnimEnd) then FOnAnimEnd(Self);
    Exit;
  end;

  case FAnimMethod of
    amForward:
      begin
        if FFrame + 1 >= Animation.Frames.Count then
        begin
          FFrame := 0;
          if Assigned(FOnAnimEnd) then FOnAnimEnd(Self);
        end 
        else
          FFrame := FFrame + 1;
      end;

    amBackward:
      begin
        if FFrame - 1 < 0 then
        begin