(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTAnimator;

interface

uses
  Windows, Sysutils,Classes,Controls, AHMStdClass,AHMStandardConst;

type
  TAHMState    = (sOpen,sClosed,sBusy);
  TAHMAnimator = class(TWinControl)
  private
    FAboutStr : TAHMAboutSControlStr;
    FPlayFrom: Smallint;
    FPlayTo: Smallint;
    FCycles: Smallint;
    FState: TAHMState;
    FAVIName: String;
    fAutoAni: Boolean;
    FCenter: Boolean;
    FTransparent: Boolean;
    procedure SetPlayRange;
    procedure SetPlayFrom(FromFrame: Smallint);
    procedure SetPlayTo(ToFrame: Smallint);
    procedure SetCycles(nCycles: Smallint);
    procedure SetAVIName(aName: String);
    procedure SetState(aState: TAHMState);
    procedure SetCenter(NewValue: Boolean);
    procedure SetTransparent(NewValue: Boolean);
    procedure SetAutoPlay(NewValue: Boolean);
    procedure SetAllData;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure OpenResource(ResID: Longint);
    procedure OpenAVIFile(Filename: String);
    procedure Loaded; override;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;
    property Enabled;
    property Visible;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property Filename: String read FAVIName write SetAVIName;
    property Center: Boolean read FCenter write SetCenter default true;
    property Transparent: Boolean read FTransparent write SetTransparent default true;
    property PlayFrom: Smallint read FPlayFrom write SetPlayFrom default 0;
    property PlayTo: Smallint read FPlayTo write SetPlayTo default -1;
    property Cycles: Smallint read FCycles write SetCycles default -1;
    property Action: TAHMState read FState write SetState default sClosed;
    property AutoAnimate: Boolean read fAutoAni write SetAutoPlay default true;
  end;

implementation
uses CommCtrl;

constructor TAHMAnimator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPlayFrom := 0;
  FPlayTo   := -1;
  FCycles   := -1;
  FState    := sClosed;
  fAutoAni  := true;
  FCenter   := True;
  FTransparent := True;
  Width  := 32;
  Height := 32;
end;

procedure TAHMAnimator.Loaded;
begin
  inherited Loaded;
end;

procedure TAHMAnimator.CreateParams(var Params: TCreateParams);
begin
  InitCommonControls;
  inherited CreateParams(Params);
  if fAutoAni     then Params.Style := Params.Style or ACS_AUTOPLAY;
  if FCenter      then Params.Style := Params.Style or ACS_CENTER;
  if FTransparent then Params.Style := Params.Style or ACS_TRANSPARENT;
  CreateSubClass(Params, ANIMATE_CLASS);
end;

destructor TAHMAnimator.Destroy;
begin
  inherited Destroy;
end;

procedure TAHMAnimator.CreateWnd;
begin
  inherited CreateWnd;
  SetAllData;
end;

procedure TAHMAnimator.SetAllData;
begin
  if (fAutoAni or (Action<>sClosed)) and (FAVIName<>'') then
  if SendMessage(Handle, ACM_OPEN, 0, Longint(PChar(FAVIName)))=0 then
     raise Exception.Create(ahmrcstderroropenavi+FAVIName)
  else SetPlayRange else
  begin
    SendMessage(Handle, ACM_OPEN, 0, 0);
    Invalidate;
  end;
end;

procedure TAHMAnimator.SetState(aState: TAHMState);
begin
  FState := aState;
  SetAllData;
end;

procedure TAHMAnimator.SetAVIName(aName: String);
begin
  FAVIName := aName;
  SetAllData;
end;

procedure TAHMAnimator.OpenResource(ResID: Longint);
begin
  if SendMessage(Handle, ACM_OPEN, 0, ResID)=0 then raise
     Exception.Create('Unable to open AVI #'+IntToStr(ResID));
  SetPlayRange;
end;

procedure TAHMAnimator.OpenAVIFile(Filename: String);
begin
  FAVIName := Filename;
  SetAllData;
end;

procedure TAHMAnimator.SetPlayRange;
begin
  if FState=sBusy then SendMessage(Handle, ACM_PLAY, FCycles, MakeLong(FPlayFrom,FPlayTo));
end;

procedure TAHMAnimator.SetPlayFrom(FromFrame: Smallint);
begin
  FPlayFrom := FromFrame;
  SetPlayRange;
end;

procedure TAHMAnimator.SetPlayTo(ToFrame: Smallint);
begin
  FPlayTo := ToFrame;
  SetPlayRange;
end;

procedure TAHMAnimator.SetCycles(nCycles: Smallint);
begin
  FCycles := nCycles;
  SetPlayRange;
end;

procedure TAHMAnimator.SetCenter(NewValue: Boolean);
begin
  if FCenter <> NewValue then
  begin
    FCenter := NewValue;
    RecreateWnd;
  end;
end;

procedure TAHMAnimator.SetTransparent(NewValue: Boolean);
begin
  if FTransparent <> NewValue then
  begin
    FTransparent := NewValue;
    RecreateWnd;
  end;
end;

procedure TAHMAnimator.SetAutoPlay(NewValue: Boolean);
begin
  if fAutoAni <> NewValue then
  begin
    fAutoAni := NewValue;
    RecreateWnd;
  end;
end;

end.

