{----------------------------------------------------------------------------- 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: JvBmpAnim.PAS, released on 2002-05-26. The Initial Developer of the Original Code is Peter Thörnqvist [peter3 at sourceforge dot net] Portions created by Peter Thörnqvist are Copyright (C) 2002 Peter Thörnqvist. All Rights Reserved. Contributor(s): You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.delphi-jedi.org Description: A bitmap animator: animates an imagelist consisting of multiple likesized bitmaps like the explorer logo in Internet Explorer or Netscape Navigator. Known Issues: -----------------------------------------------------------------------------} // $Id$ unit JvBmpAnimator; {$mode objfpc}{$H+} interface uses Classes, Graphics, Controls, ExtCtrls, ImgList, JvComponent; type TJvAnimateDirection = (tdForward, tdBack, tdFwdBack, tdBackFwd); TJvCustomBmpAnimator = class(TJvGraphicControl) private FImageList: TCustomImageList; FTimer: TTimer; FIndex: Integer; FActive: Boolean; FWidth: Integer; FHeight: Integer; FNumGlyphs: Integer; FSpeed: Integer; FTransparent: Boolean; FAutoSize: Boolean; FStart: Integer; FStop: Integer; FPosition: Integer; FDirection: TJvAnimateDirection; FGoingUp: Boolean; FCenter: Boolean; FImageChangeLink: TChangeLink; procedure SetCenter(Value: Boolean); procedure SetDirection(Value: TJvAnimateDirection); procedure SetPosition(Value: Integer); procedure SetStart(Value: Integer); procedure SetStop(Value: Integer); procedure SetTransparent(Value: Boolean); procedure SetImage(Value: TCustomImageList); procedure SetActive(Value: Boolean); procedure SetNumGlyphs(Value: Integer); procedure SetSpeed(Value: Integer); procedure TimerEvent(Sender: TObject); procedure DoChange(Sender: TObject); protected procedure Paint; override; procedure SetAutoSize(Value: Boolean); override; property AutoSize: Boolean read FAutoSize write SetAutoSize default False; procedure Notification(AComponent: TComponent; AOperation: TOperation); override; property Centered: Boolean read FCenter write SetCenter; property Color default clBtnFace; property Direction: TJvAnimateDirection read FDirection write SetDirection; property Active: Boolean read FActive write SetActive default False; property Images: TCustomImageList read FImageList write SetImage; property NumFrames: Integer read FNumGlyphs write SetNumGlyphs default 0; property Position: Integer read FPosition write SetPosition default 0; property Speed: Integer read FSpeed write SetSpeed default 100; property Min: Integer read FStart write SetStart default 0; property Max: Integer read FStop write SetStop default 0; property Transparent: Boolean read FTransparent write SetTransparent default False; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; TJvBmpAnimator = class(TJvCustomBmpAnimator) published property Active; property Align; property AutoSize; property Centered; property Color; property Direction; property Height; property Images; property Left; property Name; property NumFrames; property Position; property Speed; property Min; property Max; property Tag; property Top; property Transparent; property Width; property OnClick; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnDragDrop; property OnEndDrag; property OnStartDrag; property OnDragOver; end; implementation uses JvJVCLUtils; constructor TJvCustomBmpAnimator.Create(AOwner: TComponent); begin inherited Create(AOwner); FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := @DoChange; FWidth := 60; FHeight := 60; Width := FWidth; Height := FHeight; FTransparent := False; FAutoSize := False; FSpeed := 15; FNumGlyphs := 0; FIndex := 0; FStart := 0; FStop := 0; FPosition := 0; FActive := False; Color := clBtnFace; FTimer := TTimer.Create(nil); FTimer.OnTimer := @TimerEvent; FTimer.Enabled := FActive; FTimer.Interval := 100; FDirection := tdForward; FGoingUp := True; end; destructor TJvCustomBmpAnimator.Destroy; begin FImageChangeLink.Free; FTimer.Enabled := False; FTimer.Free; inherited Destroy; end; procedure TJvCustomBmpAnimator.DoChange(Sender: TObject); begin Invalidate; end; procedure TJvCustomBmpAnimator.TimerEvent(Sender: TObject); begin if not Assigned(FImageList) then Exit; if not Active then FIndex := FPosition else case FDirection of tdForward: begin Inc(FIndex); if (FIndex > FNumGlyphs) or (FIndex > FStop) then FIndex := FStart; end; tdBack: begin Dec(FIndex); if (FIndex < 0) or (FIndex < FStart) then FIndex := FStop; end; tdFwdBack, tdBackFwd: begin if FGoingUp then begin if (FIndex >= FStop) then begin FGoingUp := False; Dec(FIndex); end else Inc(FIndex); end else begin if FIndex <= FStart then begin FGoingUp := True; Inc(FIndex); end else Dec(FIndex); end; end; end; Refresh; end; procedure TJvCustomBmpAnimator.SetStart(Value: Integer); begin if FStart <> Value then begin FStart := Value; if FStart > FStop then FStart := FStop; if FStart >= FNumGlyphs then FStart := FNumGlyphs - 1; if FStart < 0 then FStart := 0; end; end; procedure TJvCustomBmpAnimator.SetStop(Value: Integer); begin if FStop <> Value then begin FStop := Value; if FStop < FStart then FStop := FStart; if FStop >= FNumGlyphs then FStop := FNumGlyphs - 1; if FStop < 0 then FStop := 0; end; end; procedure TJvCustomBmpAnimator.SetAutoSize(Value: Boolean); begin if FAutoSize <> Value then begin FAutoSize := Value; if FAutoSize and Assigned(FImageList) then begin Width := FImageList.Width; Height := FImageList.Height; end; end; end; procedure TJvCustomBmpAnimator.SetTransparent(Value: Boolean); begin if FTransparent <> Value then begin FTransparent := Value; Repaint; end; end; procedure TJvCustomBmpAnimator.Notification(AComponent: TComponent; AOperation: TOperation); begin inherited Notification(AComponent, AOperation); if (AOperation = opRemove) and (AComponent = FImageList) then SetImage(nil); end; procedure TJvCustomBmpAnimator.SetImage(Value: TCustomImageList); begin if FImageList <> nil then SetNumGlyphs(0); ReplaceImageListReference(Self, Value, FImageList, FImageChangeLink); if FImageList <> nil then SetNumGlyphs(FImageList.Count) else Active := False; Repaint; end; procedure TJvCustomBmpAnimator.SetActive(Value: Boolean); begin { if not Assigned(FImageList) then Value := False;} if FActive <> Value then begin FActive := Value; FTimer.Enabled := FActive; FIndex := FStart; end; Repaint; end; procedure TJvCustomBmpAnimator.SetNumGlyphs(Value: Integer); begin if FNumGlyphs <> Value then begin FNumGlyphs := Value; SetStop(FNumGlyphs - 1); end; end; procedure TJvCustomBmpAnimator.SetSpeed(Value: Integer); begin if FSpeed <> Value then begin FSpeed := Value; FTimer.Interval := 1000 div FSpeed; end; end; procedure TJvCustomBmpAnimator.SetCenter(Value: Boolean); begin if FCenter <> Value then begin FCenter := Value; Invalidate; end; end; procedure TJvCustomBmpAnimator.SetDirection(Value: TJvAnimateDirection); begin if FDirection <> Value then begin FDirection := Value; case FDirection of tdForward, tdFwdBack: begin FGoingUp := True; FIndex := FStart; end; tdBack, tdBackFwd: begin FGoingUp := False; FIndex := FStop; end; end; end; end; procedure TJvCustomBmpAnimator.SetPosition(Value: Integer); begin FPosition := Value; if FPosition > FNumGlyphs - 1 then FPosition := FNumGlyphs - 1; Invalidate; end; procedure TJvCustomBmpAnimator.Paint; var dX, dY: Integer; begin if Assigned(FImageList) then begin if FCenter then begin dX := (Width - FImageList.Width) div 2; dY := (Height - FImageList.Height) div 2; end else begin dX := 0; dY := 0; end; if not FTransparent then begin Canvas.Brush.Color := Color; Canvas.FillRect(ClientRect); end else Canvas.Brush.Style := bsClear; FImageList.Draw(Canvas, dX, dY, FIndex); if not Active then FIndex := FPosition; FImageList.Draw(Canvas, dX, dY, FIndex) end; if csDesigning in ComponentState then with Canvas do begin Brush.Color := clBlack; FrameRect( GetClientRect); end; end; end.