AVI player

An AVI player for Delphi

Contributor: ANDREA MOLINO





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.

 

Share this article!

Follow us!

Find more helpful articles: