PC World 1999 February/PCWorld_1999-02_cd.bin/temacd/HotKeys/AniPlay.pas

Pascal/Delphi Source File | 1997-04-11 | 7KB | 251 lines

unit AniPlay;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  AniIcons;

type
  TRepeatCount = 0..MAXINT;

  TAnimatedIconPlayer = class(TCustomControl)
  private
    FActiveFrame: Integer;
    FAnimation  : TAnimatedIcons;
    FAutoSize   : Boolean;
    FBorderStyle: TBorderStyle;
    FCentered   : Boolean;
    FRepeatCount: TRepeatCount;
    FOnStopped  : TNotifyEvent;
    function  GetPlaying: Boolean;
    procedure SetActiveFrame(Value: Integer);
    procedure SetAnimation(Value: TAnimatedIcons);
    procedure SetAutoSize(Value: Boolean);
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetCentered(Value: Boolean);
    procedure SetPlaying(Value: Boolean);
    { Private declarations }
  protected
    { Protected declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED;
    procedure wmSize(var Msg: TWMSize); message WM_SIZE;
    procedure Paint; override;

    procedure NewFrame(Sender: TObject; Frame: Integer);
    procedure Stopped(Sender: TObject);
    procedure AutoSizeComponent;
    procedure DisplayFrame;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Play;
    procedure Stop;
  published
    property Animation: TAnimatedIcons read FAnimation write SetAnimation;
    property ActiveFrame: Integer read FActiveFrame write SetActiveFrame default 0;
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Centered: Boolean read FCentered write SetCentered default True;
    property Color;
    property Ctl3D;
    property Enabled;
    property ParentColor;
    property ParentCtl3D;
    property Playing: Boolean read GetPlaying write SetPlaying;
    property RepeatCount: TRepeatCount read FRepeatCount write FRepeatCount default 0;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStopped: TNotifyEvent read FOnStopped write FOnStopped;
    { Published declarations }
  end;

implementation

constructor TAnimatedIconPlayer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks];
  FActiveFrame := 0;
  FAnimation := TAnimatedIcons.Create(is32x32);
  FAnimation.OnStopped := Stopped;
  FAnimation.OnNewFrame := NewFrame;
  FAutoSize := False;
  FBorderStyle := bsSingle;
  FCentered := True;
  FRepeatCount := 0;
  Width := 40;
  Height := 40;
end;

destructor TAnimatedIconPlayer.Destroy;
begin
  FAnimation.Free;
  inherited Destroy;
end;

procedure TAnimatedIconPlayer.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
   begin
     Style := Style or WS_TABSTOP;
     WindowClass.style := CS_DBLCLKS;
     if FBorderStyle = bsSingle then
      if NewStyleControls and Ctl3D then
       begin
         Style := Style and not WS_BORDER;
         ExStyle := ExStyle or WS_EX_CLIENTEDGE;
       end
      else
       Style := Style or WS_BORDER;
   end;
end;

function TAnimatedIconPlayer.GetPlaying: Boolean;
begin
  Result := Animation.Playing;
end;

procedure TAnimatedIconPlayer.SetPlaying(Value : Boolean);
begin
  if Animation.Playing <> Value then
   begin
     if Value then Animation.Play(RepeatCount) else Animation.Stop;
   end;
end;

procedure TAnimatedIconPlayer.SetActiveFrame(Value: Integer);
begin
  if FActiveFrame<>Value then
   begin
     if (Value>=0) and (Value<=FAnimation.Count) then
      begin
        FActiveFrame := Value;
        if not FAnimation.Playing then
         if FActiveFrame>0 then
          DisplayFrame
         else
          Invalidate;
      end;
   end;
end;

procedure TAnimatedIconPlayer.SetAnimation(Value: TAnimatedIcons);
begin
  FAnimation.Assign(Value);
  if FActiveFrame>FAnimation.Count then
   FActiveFrame := FAnimation.Count;
  if not FAnimation.Playing then Invalidate;
end;

procedure TAnimatedIconPlayer.SetAutoSize(Value: Boolean);
begin
  if FAutoSize<>Value then
   begin
     FAutoSize := Value;
     if FAutoSize then AutoSizeComponent;
   end;
end;

procedure TAnimatedIconPlayer.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
   begin
     FBorderStyle := Value;
     RecreateWnd;
     if AutoSize then AutoSizeComponent;
   end;
end;

procedure TAnimatedIconPlayer.CMCtl3DChanged(var Msg: TMessage);
begin
  inherited;
  RecreateWnd;
end;

procedure TAnimatedIconPlayer.wmSize(var Msg: TWMSize);
begin
  inherited;
  Invalidate;
end;

procedure TAnimatedIconPlayer.SetCentered(Value: Boolean);
begin
  if FCentered <> Value then
   begin
     FCentered := Value;
     Invalidate;
   end;
end;

procedure TAnimatedIconPlayer.AutoSizeComponent;
var
  Size: Integer;
begin
  if Animation.IconSize = is16x16 then Size := 16 else Size := 32;
  SetBounds(Left, Top, Size + Width - ClientWidth, Size + Height - ClientHeight);
end;

procedure TAnimatedIconPlayer.Play;
begin
  Animation.Play(RepeatCount);
end;

procedure TAnimatedIconPlayer.Stop;
begin
  Animation.Stop;
end;

procedure TAnimatedIconPlayer.Paint;
begin
  inherited Paint;
  DisplayFrame;
end;

procedure TAnimatedIconPlayer.Stopped(Sender: TObject);
begin
  if Assigned(FOnStopped) then FOnStopped(Self);
end;

procedure TAnimatedIconPlayer.NewFrame(Sender: TObject; Frame: Integer);
begin
  FActiveFrame := Frame+1;
  DisplayFrame;
end;

procedure TAnimatedIconPlayer.DisplayFrame;
var
  IconSize, IconLeft, IconTop: Integer;
begin
  if (ActiveFrame=0) then Exit;
  if Animation.IconSize = is16x16 then IconSize := 16 else IconSize := 32;
  if Centered then
   begin
     IconLeft := (ClientWidth - IconSize) div 2;
     IconTop := (ClientHeight - IconSize) div 2;
   end
  else
   begin
     IconLeft := 0;
     IconTop := 0;
   end;
  Animation.DrawIcon(Canvas, IconLeft, IconTop, ActiveFrame-1, Color);
end;

end.