[Back to DELPHI SWAG index]  [Back to Main SWAG index]  [Original]

This is a control for playing avi files.

unit AVICtrl;

interface

{                           TAVIControl V 0.9b
                              Programmed by
                              Andrea Molino
                           easytarg@mbox.vol.it
}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, CommCtrl;

Type
  TAVIControlState = (acsClose, acsOpen, acsPlay);
  TAVIControlError = (acrOK, acrOpenFailed, acrPlayFailed, acsSeekFailed);

  TAVIControl = class(TWinControl)
  private
    FAVIState: TAVIControlState;
    FAVIName: String;
    FFrameFrom: SmallInt;
    FFrameTo: SmallInt;
    FFrameSeek: SmallInt;
    FAutoSize: Boolean;
    FAutoRepeat: Boolean;
    FLastOpStatus: TAVIControlError;
    FAux: String;
    Procedure SetAVIState(Val: TAVIControlState);
    Procedure SetAVIName(Val: String);
    Procedure SetFrameFrom(Val: SmallInt);
    Procedure SetFrameTo(Val: SmallInt);
    Procedure SetFrameSeek(Val: SmallInt);
    Procedure SetAutoSize(Val: Boolean);
    Procedure SetAutoRepeat(Val: Boolean);
    Function  GetLastOpStatus: String;
  protected
    procedure CreateParams(var Params: TCreateParams); Override;
    procedure CreateWnd; Override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    Function  Open(FileName: String): Boolean;
    Procedure Close;
    Function  Play(FName: String; RepCount: SmallInt): Boolean;
    Function  Seek(Frame: SmallInt): Boolean;
    Procedure Stop;
  published
    Property AVIState: TAVIControlState Read FAVIState Write SetAVIState Default acsClose;
    Property AVIName: String Read FAVIName Write SetAVIName;
    Property FrameFrom: SmallInt Read FFrameFrom Write SetFrameFrom Default 0;
    Property FrameTo: SmallInt Read FFrameTo Write SetFrameTo Default -1;
    Property FrameSeek: SmallInt Read FFrameSeek Write SetFrameSeek Default 0;
    Property AutoSize: Boolean Read FAutoSize Write SetAutoSize Default False;
    Property AutoRepeat: Boolean Read FAutoRepeat Write SetAutoRepeat Default True;
    Property ZStatus: String Read GetLastOpStatus Write FAux;
    property Align;
    property Enabled;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

Constructor TAVIControl.Create(AOwner: TComponent);
Begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle -[csSetCaption];
  FAVIState := acsClose;
  FFrameFrom := 0;
  FFrameTo := -1;
  FAutoSize := False;
  FAutoRepeat := True;
  FLastOpStatus := acrOK;
  Width := 30;
  Height := 30;
End;

Destructor TAVIControl.Destroy;
Begin
  Inherited Destroy;
End;

procedure TAVIControl.CreateParams(var Params: TCreateParams);
begin
{ACS_AUTOPLAY    - Starts playing the animation as soon as the animation clip is opened.
 ACS_CENTER      - Centers the animation in the animation control's window.
 ACS_TRANSPARENT - Draws the animation using a transparent background rather than
                   the background color specified in the animation clip.}
  InitCommonControls;
  Inherited CreateParams(Params);
  CreateSubClass(Params, 'SysAnimate32');
  With Params do
  Begin
    Style := Style Or ACS_TRANSPARENT;
    If Not FAutoSize Then Style := Style Or ACS_CENTER;
  End;
end;

procedure TAVIControl.CreateWnd;
begin
  Inherited CreateWnd;
  If FAVIState = acsOpen Then Open(FAVIName);
  If FAVIState = acsPlay Then
  Begin
    Open(FAVIName);
    Play('', 0);
  End;
end;

Procedure TAVIControl.SetAVIState(Val: TAVIControlState);
Begin
  If Val <> FAVIState Then
  Begin
    FAVIState := Val;
    Case FAVIState Of
      acsOpen : Begin
                  Open(FAVIName)
                End;
      acsPlay : Begin
                  Open(FAVIName);
                  Play('', 0);
                End;
      acsClose: Close;
    End;
  End;
End;

Procedure TAVIControl.SetAVIName(Val: String);
Var
  FTmpState: TAVIControlState;
Begin
  If Val <> FAVIName Then
  Begin
    FAVIName := Val;
    FTmpState := FAVIState;
    Close;
    If FTmpState = acsOpen Then Open(FAVIName);
    If FTmpState = acsPlay Then Play('', 0);
  End;
End;

Procedure TAVIControl.SetFrameFrom(Val: SmallInt);
Begin
  If Val <> FFrameFrom Then
  Begin
    FFrameFrom := Val;
    If FAVIState = acsPlay Then Play('', 0);
  End;
End;

Procedure TAVIControl.SetFrameTo(Val: SmallInt);
Begin
  If Val <> FFrameTo Then
  Begin
    FFrameTo := Val;
    If FAVIState = acsPlay Then Play('', 0);
  End;
End;

Procedure TAVIControl.SetFrameSeek(Val: SmallInt);
Begin
  If Val <> FFrameSeek Then
  Begin
    FFrameSeek := Val;
    Seek(FrameSeek);
  End;
End;

Procedure TAVIControl.SetAutoSize(Val: Boolean);
Begin
  If Val <> FAutoSize Then
  Begin
    FAutoSize := Val;
    RecreateWnd;
  End;
End;

Procedure TAVIControl.SetAutoRepeat(Val: Boolean);
Begin
  If Val <> FAutoRepeat Then
  Begin
    FAutoRepeat := Val;
    If FAVIState = acsPlay Then Play('', 0);
  End;
End;

Function TAVIControl.GetLastOpStatus: String;
Begin
  Case FLastOpStatus Of
    acrOK        : Result := 'OK';
    acrOpenFailed: Result := 'Open Failed';
    acrPlayFailed: Result := 'Play Failed';
  End;
End;

Function TAVIControl.Open(FileName: String): Boolean;
Var
  Res: LongInt;
Begin
  FLastOpStatus := acrOK;
  If FAVIState <> acsClose Then Close;
  Res := SendMessage(Handle, ACM_OPEN, 0, LongInt(PChar(FileName)));
  FAVIName := FileName;
  If Res <> 0 Then FAVIState := acsOpen
  Else FLastOpStatus := acrOpenFailed;
  Result := (Res <> 0);
End;

Procedure TAVIControl.Close;
Var
  Res: LongInt;
Begin
  FLastOpStatus := acrOK;
  Res := SendMessage(Handle, ACM_OPEN, 0, 0);
  FAVIState := acsClose;
  Repaint;
End;

Function TAVIControl.Seek(Frame: SmallInt): Boolean;
Var
  Res: LongInt;
Begin
  FLastOpStatus := acrOK;
  If FAVIState = acsClose Then Open(FAVIName)
  Else If FAVIState = acsPlay Then Stop;
  If FAVIState <> acsClose Then
  Begin
    Res := SendMessage(Handle, ACM_PLAY, 1, MAKELONG(Frame, Frame));
    If Res = 0 Then FLastOpStatus := acsSeekFailed;
    Result := (Res <> 0);
  End
  Else Result := False;
End;

Function TAVIControl.Play(FName: String; RepCount: SmallInt): Boolean;
Var
  Res: LongInt;
  Rep: SmallInt;
Begin
  FLastOpStatus := acrOK;
  If FName = '' Then Open(FAVIName)
  Else Open(FName);
  If FAVIState <> acsClose Then
  Begin
    If FAutoRepeat And (RepCount = 0) Then Rep := -1
    Else If RepCount = 0 Then Rep := 1
    Else Rep := RepCount;
    Res := SendMessage(Handle, ACM_PLAY, Rep, MAKELONG(FFrameFrom, FFrameTo));
    If (Res <> 0) And FAutoRepeat Then FAVIState := acsPlay
    Else FLastOpStatus := acrPlayFailed;
    Result := (Res <> 0);
  End
  Else Result := False;
End;

Procedure TAVIControl.Stop;
Var
  Res: LongInt;
Begin
  FLastOpStatus := acrOK;
  If FAVIState <> acsClose Then
  Begin
    Res := SendMessage(Handle, ACM_PLAY, 0, MAKELONG(0, 0));
    If FAVIState = acsPlay Then FAVIState := acsOpen;
  End;
End;

procedure Register;
begin
  RegisterComponents('MyGold', [TAVIControl]);
end;

end.

[Back to DELPHI SWAG index]  [Back to Main SWAG index]  [Original]