cdibbutton.pas

Delphi控件

          FFrame := Animation.Frames.Count - 1;
          if Assigned(FOnAnimEnd) then FOnAnimEnd(Self);
        end 
        else
          FFrame := FFrame - 1;
      end;

    amPingPong:
      begin
        if FFrame + FAnimDir < 0 then
          if Assigned(FOnAnimEnd) then FOnAnimEnd(Self);

        if (FFrame + FAnimDir < 0) or (FFrame + FAnimDir >= Animation.Frames.Count) then
          FAnimDir := -FAnimDir;
        FFrame := FFrame + FAnimDir;
      end;
  end;
end;

constructor TCustomDIBButtonAnim.Create(AOwner: TComponent);
begin
  inherited Create;
  FAnimationLink := TDIBAnimationLink.Create;
  FAnimationLink.OnAnimationChanged := DoAnimationChanged;
  FFrameDelay := 100;
  FAnimDir := 1;
end;

destructor TCustomDIBButtonAnim.Destroy;
begin
  FAnimationLink.Free;
  inherited;
end;

procedure TCustomDIBButtonAnim.DoAnimationChanged(Sender: TObject);
begin
  if Assigned(FOnAnimationChanged) then FOnAnimationChanged(Self);
end;

function TCustomDIBButtonAnim.GetAnimation: TDIBAnimation;
begin
  Result := FAnimationLink.Animation;
end;

function TCustomDIBButtonAnim.GetDimensions: TPoint;
begin
  if Animation <> nil then
    Result := Animation.GetDimensions;
end;

function TCustomDIBButtonAnim.GetImage(var TheDIB: TMemoryDIB): Boolean;
begin
  Result := Animation.GetImage(FFrame, TheDIB);
end;

procedure TCustomDIBButtonAnim.Reset;
begin
  if FAnimMethod = amBackward then
    FFrame := Animation.Frames.Count - 1
  else
    FFrame := 0;
end;

procedure TCustomDIBButtonAnim.SetAnimation(const Value: TDIBAnimation);
begin
  FAnimationLink.Animation := Value;
  if Assigned(OnAnimationChanged) then FOnAnimationChanged(Self);
end;

function TCustomDIBButtonAnim.Valid: Boolean;
begin
  Result := False;
  if Animation <> nil then
    Result := Animation.Valid;
end;

{ TCustomDIBButton }


procedure TCustomDIBButton.Animate;
begin
  AnimPic.Animate;
  Invalidate;
end;

procedure TCustomDIBButton.AnimationChanged;
var
  OldAnim: TCurrentAnim;
begin
  if CurrentAnim = caNone then
    OldAnim := caEnabled
  else
    OldAnim := CurrentAnim;
  FCurrentAnim := caNone;
  CurrentAnim := OldAnim;
  if AutoSize then AdjustSize;
  Invalidate;
end;

procedure TCustomDIBButton.AnimEnd;
begin
  case CurrentAnim of
    caMouseEnter: CurrentAnim := caMouseOver;
    caMouseLeave: CurrentAnim := caEnabled;
    caMouseClick:
      begin
        if ToggleDown then 
        begin
          FDown := not Down;
          if Down then
            CurrentAnim := caDown
          else
            CurrentAnim := caMouseOver;
        end 
        else 
        begin
          if Focused or MouseInControl then
            CurrentAnim := caMouseOver
          else
            CurrentAnim := caMouseLeave;
        end;
        inherited Click;
      end;
  end;
end;

function TCustomDIBButton.CanAutoSize(var NewWidth,
  NewHeight: Integer): Boolean;
var
  NewSizes: TPoint;
begin
  if (AnimPic <> nil) and AnimPic.Valid then
  begin
    NewSizes := AnimPic.GetDimensions;
    NewWidth := NewSizes.X;
    NewHeight := NewSizes.Y;
    Result := True;
  end else
    Result := False;
end;

procedure TCustomDIBButton.Click;
begin
  if Enabled then CurrentAnim := caMouseClick;
end;

constructor TCustomDIBButton.Create(AOwner: TComponent);
begin
  inherited;
  FAnimEnabled := TDIBButtonAnim.Create(Self);
  FAnimDisabled := TDIBButtonAnim.Create(Self);
  FAnimMouseEnter := TDIBButtonAnim.Create(Self);
  FAnimMouseOver := TDIBButtonAnim.Create(Self);
  FAnimMouseClick := TDIBButtonAnim.Create(Self);
  FAnimDown := TDIBButtonAnim.Create(Self);
  FAnimMouseLeave := TDIBButtonAnim.Create(Self);

  FAnimEnabled.OnAnimationChanged := DoAnimationChanged;
  FAnimDisabled.OnAnimationChanged := DoAnimationChanged;
  FAnimMouseEnter.OnAnimationChanged := DoAnimationChanged;
  FAnimMouseOver.OnAnimationChanged := DoAnimationChanged;
  FAnimMouseClick.OnAnimationChanged := DoAnimationChanged;
  FAnimDown.OnAnimationChanged := DoAnimationChanged;
  FAnimMouseLeave.OnAnimationChanged := DoAnimationChanged;

  FTimer := TDIBTimer.Create(Self);
  FCurrentAnim := caNone;
  FTimer.OnTimer := DoTimer;
  AutoSize := True;
end;

destructor TCustomDIBButton.Destroy;
begin
  FTimer.Free;
  FAnimEnabled.Free;
  FAnimDisabled.Free;
  FAnimMouseEnter.Free;
  FAnimMouseOver.Free;
  FAnimMouseClick.Free;
  FAnimDown.Free;
  FAnimMouseLeave.Free;
  inherited;
end;

procedure TCustomDIBButton.DoAnimationChanged(Sender: TObject);
begin
  if not (csLoading in ComponentState) then AnimationChanged;
end;

procedure TCustomDIBButton.DoAnimEnd(Sender: TObject);
begin
  AnimEnd;
end;

procedure TCustomDIBButton.DoAnyEnter;
begin
  inherited;
  if CurrentAnim <> caMouseClick then
    if not Down then CurrentAnim := caMouseEnter;
end;

procedure TCustomDIBButton.DoAnyLeave;
begin
  if CurrentAnim <> caMouseClick then
    if not (MouseInControl or Focused) then CurrentAnim := caMouseLeave;
  inherited;
end;

procedure TCustomDIBButton.DoTimer(Sender: TObject);
begin
  Animate;
end;

procedure TCustomDIBButton.Loaded;
begin
  inherited;
  if Down then
    CurrentAnim := caDown
  else if Enabled then
    CurrentAnim := caEnabled
  else
    CurrentAnim := caDisabled;
end;

procedure TCustomDIBButton.Paint;
var
  TheDIB: TMemoryDIB;
begin
  if AnimPic <> nil then
    if AnimPic.GetImage(TheDIB) then
      if fCenter then
        TheDIB.Draw((Width - TheDIB.Width) div 2,
        (Height - TheDIB.Height) div 2,
          TheDIB.Width, TheDIB.Height, ControlDIB, 0, 0)
      else
        TheDIB.Draw(0, 0, TheDIB.Width, TheDIB.Height, ControlDIB, 0, 0);
end;

procedure TCustomDIBButton.SetAnimPic(const Value: TDIBButtonAnim);
var
  MinimumFrameCount: Integer;
begin
  if Value = AnimPic then exit;

  if CurrentAnim in [caEnabled, caDisabled, caDown, caMouseOver] then
    MinimumFrameCount := 2
  else
    MinimumFrameCount := 1;

  FAnimPic := Value;
  FAnimPic.FOnAnimEnd := DoAnimEnd;
  FAnimPic.Reset;
  FTimer.Enabled :=
    (not (csDesigning in ComponentState)) and
    (AnimPic.Animation.Valid) and
    (AnimPic.Animation.Frames.Count >= MinimumFrameCount);
  FTimer.Interval := AnimPic.FrameDelay;
  FTimer.OnTimer := DoTimer;
end;

procedure TCustomDIBButton.SetCenter(const Value: Boolean);
begin
  if Value <> FCenter then
  begin
    FCenter := Value;
    AnimationChanged;
  end;
end;

procedure TCustomDIBButton.SetCurrentAnim(const Value: TCurrentAnim);
var
  NewAnim: TDIBButtonAnim;
  IsValid: Boolean;
  Handled: Boolean;
begin
  if CurrentAnim = Value then exit;
  Handled := False;

  if not Enabled and FAnimDisabled.Valid then 
  begin
    AnimPic := FAnimDisabled;
    FCurrentAnim := caDisabled;
    Handled := True;
  end;

  if not Handled then
    if Down and FAnimDown.Valid and (Value <> caMouseClick) then 
    begin
      SetOthersUp;
      AnimPic := FAnimDown;
      FCurrentAnim := caDown;
      Handled := True;
    end;

  NewAnim := nil;
  if not Handled then 
  begin
    case Value of
      caDisabled: NewAnim := FAnimDisabled;
      caEnabled: NewAnim := FAnimEnabled;
      caMouseEnter: NewAnim := FAnimMouseEnter;
      caMouseOver: NewAnim := FAnimMouseOver;
      caMouseClick: NewAnim := FAnimMouseClick;
      caMouseLeave: NewAnim := FAnimMouseLeave;
      caDown: NewAnim := FAnimDown;
    end;

    IsValid := NewAnim.Valid;
    if (Value = caMouseOver) and not (MouseInControl or Focused) then IsValid := False;
    if not IsValid then 
    begin
      case Value of
        caEnabled: exit;
        caMouseClick:
          begin
            //If the click anim is not valid, we pretend it just ended
            FCurrentAnim := caMouseClick;
            AnimEnd;
          end;
        caMouseEnter: CurrentAnim := caMouseOver;
        caDisabled,
        caMouseOver,
        caMouseLeave,
        caDown: CurrentAnim := caEnabled;
      end;
    end
    else
    begin
      FCurrentAnim := Value;
      AnimPic := NewAnim;
    end;
  end;

  if AutoSize then AdjustSize;
  Invalidate;
end;

procedure TCustomDIBButton.SetDown(const Value: Boolean);
begin
  inherited;
  if Down then
    CurrentAnim := caDown
  else
    CurrentAnim := caMouseOver;
end;

procedure TCustomDIBButton.SetEnabled(Value: Boolean);
begin
  if Value = Enabled then exit;
  inherited;
  if not Value then
    CurrentAnim := caDisabled
  else
    CurrentAnim := caMouseOver;
end;

end.