0,0 → 1,460 |
{ |
SXMedia Components - Beta 1 |
-------------------------------- |
Copyright 1999 Dean Ellis |
http://www.sillex.freeserve.co.uk |
|
This unit is part of the SXMedia Component Set. This code is |
supplied as is with no guarantees and must be used at your own |
risk. |
|
No modifications to this code must be made without the express |
permission of the author. Please report any problems to |
support@sillex.freeserve.co.uk |
|
You may use these components to create any freeware/shareware |
applications that you wish. If the components are to be used in |
a commercail product then credit for developement of these components |
should be given. |
|
Credits : |
|
Developer : Dean Ellis |
Testers : Dominique Louis |
Ivan Blecic |
} |
unit SXMovie; |
|
{$INCLUDE DelphiXcfg.inc} |
|
interface |
|
uses |
Windows, Classes, SysUtils, ActiveX, Math, Dialogs, |
DXSounds, DXDraws, |
{$IFDEF StandardDX} |
DirectDraw, DirectSound, DirectShow9, |
{$IFDEF DX7} |
{$IFDEF D3DRM} |
Direct3DRM, |
{$ENDIF} |
Direct3D; |
{$ENDIF} |
{$IFDEF DX9} |
Direct3D9, Direct3D, D3DX9, {Direct3D8,} DX7toDX8; |
{$ENDIF} |
{$ELSE} |
DShow, DirectX; |
{$ENDIF} |
|
type |
TMovieOptions = (VideoAndSound, VideoOnly); |
TDisplay = (FullScreen, WideScreen, OriginalSize); |
|
TScreenRect = class(TPersistent) |
private |
FLeft: integer; |
FRight: integer; |
FTop: integer; |
FBottom: integer; |
procedure SetLeft(Value: integer); |
procedure SetRight(Value: integer); |
procedure SetTop(Value: integer); |
procedure SetBottom(Value: integer); |
protected |
public |
procedure Assign(Value: TScreenRect); |
published |
property Left: integer read FLeft write SetLeft; |
property Right: integer read FRight write SetRight; |
property Top: integer read FTop write SetTop; |
property Bottom: integer read FBottom write SetBottom; |
end; |
|
|
TSXMovie = class; |
|
TMovieThread = class(TThread) |
private |
{ Private declarations } |
FSXMovie: TSXMovie; |
protected |
procedure Execute; override; |
public |
property SXMovie: TSXMovie read FSXMovie write FSXMovie; |
end; |
|
TSXMovie = class(TComponent) |
private |
FMovieThread: TMovieThread; |
FDXDraw: TDXDraw; |
FDXSound: TDXSound; |
FMMStream: IMultiMediaStream; |
FPrimaryVidStream: IMediaStream; |
FDDStream: IDirectDrawMediaStream; |
FSample: IDirectDrawStreamSample; |
FSurface: IDirectDrawSurface; |
FDXSurface: TDirectDrawSurface; |
FRect: TRect; |
FDestRect: TRect; |
FScreenRect: TScreenRect; |
FFilename: TFilename; |
FPlaying: Boolean; |
FDoFlip: Boolean; |
{Event} |
FOnMovieEnd: TNotifyEvent; |
FOnBeforeRender: TNotifyEvent; |
FOnAfterRender: TNotifyEvent; |
procedure SetFilename(Value: TFilename); |
procedure SetScreenRect(Value: TScreenRect); |
procedure DoMovieEnd; |
procedure DoBeforeRender; |
procedure DoAfterRender; |
protected |
procedure Notification(AComponent: TComponent; Operation: TOperation); override; |
procedure SetMovieStateRun; |
procedure SetMovieStateStop; |
procedure CreateMediaStream; virtual; |
procedure SetupMediaSample; virtual; |
public |
constructor Create(AOwner: TComponent); override; |
destructor Destroy; override; |
procedure UpDate; virtual; |
// function SetDisplay(Value:TDisplay):Boolean; |
procedure DisplayRect(Top, Left, Right, Bottom: integer); |
procedure Play; |
procedure Stop; |
{} |
published |
property DXDraw: TDXDraw read FDXDraw write FDXDraw; |
property DXSound: TDXSound read FDXSound write FDXSound; |
property Filename: TFilename read FFilename write SetFilename; |
property Playing: Boolean read FPlaying; |
property DoFlip: Boolean read FDoFlip write FDoFlip; |
property DestinationRectangle: TScreenRect read FScreenRect write SetScreenRect; |
property OnMovieEnd: TNotifyEvent read FOnMovieEnd write FOnMovieEnd; |
property OnBeforeRender: TNotifyEvent read FOnBeforeRender write FOnBeforeRender; |
property OnAfterRender: TNotifyEvent read FOnAfterRender write FOnAfterRender; |
end; |
|
implementation |
|
uses Graphics; |
|
procedure TScreenRect.SetLeft(Value: integer); |
begin |
FLeft := Value; |
end; |
|
procedure TScreenRect.SetRight(Value: integer); |
begin |
FRight := Value; |
end; |
|
procedure TScreenRect.SetTop(Value: integer); |
begin |
FTop := Value; |
end; |
|
procedure TScreenRect.SetBottom(Value: integer); |
begin |
FBottom := Value; |
end; |
|
procedure TScreenRect.Assign(Value: TScreenRect); |
begin |
Left := Value.Left; |
Right := Value.Right; |
Top := Value.Top; |
Bottom := Value.Bottom; |
end; |
|
{ Important: Methods and properties of objects in VCL can only be used in a |
method called using Synchronize, for example, |
|
Synchronize(UpdateCaption); |
|
and UpdateCaption could look like, |
|
procedure TMovieThread.UpdateCaption; |
begin |
Form1.Caption := 'Updated in a thread'; |
end; } |
|
{ TMovieThread } |
|
procedure TMovieThread.Execute; |
begin |
{ Place thread code here } |
if Assigned(SXMovie) then |
SXMovie.SetMovieStateRun; |
while (not Terminated) and Assigned(SXMovie) do |
begin |
Synchronize(SXMovie.UpDate) |
end; |
if Assigned(SXMovie) then |
SXMovie.SetMovieStateStop; |
end; |
|
{SXMovie} |
|
procedure TSXMovie.SetFilename(Value: TFilename); |
begin |
if Value <> '' then |
FFilename := Value; |
end; |
|
procedure TSXMovie.SetScreenRect(Value: TScreenRect); |
begin |
FScreenRect.Assign(Value); |
end; |
|
procedure TSXMovie.DoMovieEnd; |
begin |
if Assigned(FOnMovieEnd) then FOnMovieEnd(Self); |
end; |
|
procedure TSXMovie.DoBeforeRender; |
begin |
if Assigned(FOnBeforeRender) then FOnBeforeRender(Self); |
end; |
|
procedure TSXMovie.DoAfterRender; |
begin |
if Assigned(FOnAfterRender) then FOnAfterRender(Self); |
end; |
|
procedure TSXMovie.Notification(AComponent: TComponent; Operation: TOperation); |
begin |
if Operation = opRemove then |
begin |
if AComponent is TDXDraw then FDXDraw := nil; |
if AComponent is TDXSound then FDXSound := nil; |
end; |
inherited; |
end; |
|
procedure TSXMovie.SetMovieStateRun; |
begin |
try |
if FMMStream.SetState(STREAMSTATE_RUN) <> S_OK then |
Exception.Create('Set Movie State Run Exception'); |
except |
end; |
end; |
|
procedure TSXMovie.SetMovieStateStop; |
begin |
try |
FMMStream.SetState(STREAMSTATE_STOP); |
finally |
FPlaying := False; |
end; |
end; |
|
procedure TSXMovie.CreateMediaStream; |
var |
wPath:{$IFDEF UNICODE}array of Char{$ELSE}array[0..MAX_PATH] of WChar{$ELSE}{$ENDIF}; |
AMStream:IAMMultiMediaStream; |
Media:IMediaStream; |
begin |
Media := nil; |
AMStream := nil; |
try |
CoCreateinstance(CLSID_AMMULTIMEDIASTREAM,nil,CLSCTX_INPROC_SERVER,IID_IAMMULTIMEDIASTREAM,AMStream); |
{$IFDEF UNICODE} |
SetLength(wPath, Length(Filename) + 1); |
StrPCopy(@wPath, Filename); |
{$ELSE} |
MultiByteToWideChar(CP_ACP,0,PAnsiChar(Filename),-1,wPath,Sizeof(wPAth) div sizeof(wPath[0])); |
{$ENDIF} |
AMStream.Initialize(STREAMTYPE_READ,AMMSF_NOGRAPHTHREAD,nil); |
if (DXSound <> nil) and (DXSound.DSound <> nil) and (DXSound.DSound.ISound <> nil) then |
AMStream.AddMediaStream(DXSound.DSound.ISound,{$IFDEF UNICODE}@{$ENDIF}MSPID_PrimaryAudio,AMMSF_ADDDEFAULTRENDERER,IMediaStream(nil^)); |
AMStream.AddMediaStream(DXDraw.DDraw.IDraw,{$IFDEF UNICODE}@{$ENDIF}MSPID_PrimaryVideo,0,Media); |
AMStream.OpenFile({$IFDEF UNICODE}@{$ENDIF}wPAth,0); |
FMMStream := AMStream; |
except |
FMMStream := nil; |
end; |
end; |
|
procedure TSXMovie.SetupMediaSample; |
begin |
try |
FSample := nil; |
FDDStream := nil; |
FPrimaryVidStream := nil; |
if FMMStream.GetMediaStream(MSPID_PrimaryVideo, FPrimaryVidStream) <> S_OK then Exit; |
if FPrimaryVidStream.QueryInterface(IID_IDirectDrawMediaStream, FDDStream) <> S_OK then Exit; |
if FDDStream.CreateSample(nil, PRect(nil)^, 0, FSample) <> S_OK then Exit; |
FDXSurface := TDirectDrawSurface.Create(FDXDraw.DDraw); |
if FSample.GetSurface(FSurface, FRect) <> S_OK then Exit; |
FDXSurface.IDDSurface := FSurface; |
except |
|
end; |
end; |
|
procedure TSXMovie.UpDate; |
function AspectRatio(SourceRect: TRect; var DestRect: TRect): Boolean; |
var |
SourceWidth, SourceHeight, DestWidth, DestHeight: Integer; |
SourceRatio, DestRatio: Double; |
begin |
Result := False; |
SourceWidth := SourceRect.Right - SourceRect.Left; |
SourceHeight := SourceRect.Bottom - SourceRect.Top; |
SourceRatio := SourceWidth/SourceHeight; |
|
DestWidth := DestRect.Right - DestRect.Left; |
DestHeight := DestRect.Bottom - DestRect.Top; |
DestRatio := DestWidth/DestHeight; |
if SourceRatio <> DestRatio then |
begin |
if DestWidth > DestHeight then |
DestRect.Bottom := DestRect.Top + Round(DestWidth / SourceRatio) |
else |
DestRect.Right := DestRect.Left + Round(SourceRatio * DestHeight); |
Result := True; |
end; |
end; |
var |
R: TRect; |
Q: HResult; |
begin |
try |
Q := FSample.Update(0, 0, nil, 0); |
case Q of |
HResult(MS_S_PENDING):; |
HResult(MS_S_NOUPDATE):; |
HResult(MS_S_ENDOFSTREAM):; |
end; |
if Q <> S_OK then |
begin |
FMovieThread.Terminate; |
SetMovieStateStop; |
FPlaying := False; |
DoMovieEnd; |
Exit; |
end; |
if (FSurface <> nil) and DXDraw.CanDraw then |
begin |
DoBeforeRender; |
R := FDestRect; |
if AspectRatio(FRect, R) then |
FDestRect := R; |
DXDraw.Surface.StretchDraw(FDestRect, FRect, FDXSurface, False); |
with DXDraw.Surface.Canvas do |
begin |
Brush.Style := bsClear; |
Font.Color := clWhite; |
Font.Size := 8; |
Textout(5, 5, 'SilleX Media - Beta 1'); |
Release; |
end; |
DoAfterRender; |
if DoFlip then |
DXDraw.Flip; |
end; |
except |
on E: Exception do |
ShowMessage(E.Message); |
end; |
end; |
|
procedure TSXMovie.DisplayRect(Top, Left, Right, Bottom: integer); |
begin |
if not (csDesigning in ComponentState) then |
begin |
FScreenRect.Top := Top; |
FSCreenRect.Left := Left; |
FScreenRect.Right := Right; |
FScreenRect.Bottom := Bottom; |
end; |
end; |
|
procedure TSXMovie.Play; |
begin |
if not (csDesigning in ComponentState) then |
begin |
FDestRect.Left := FScreenRect.Left; |
FDestRect.Right := FScreenRect.Right; |
FDestRect.Top := FScreenRect.Top; |
FDestRect.Bottom := FScreenRect.Bottom; |
FPlaying := True; |
CreateMediaStream; |
SetupMediaSample; |
if FSample <> nil then |
begin |
FMovieThread := TMovieThread.Create(True); |
if Assigned(FMovieThread) then |
begin |
FMovieThread.FreeOnTerminate := False; |
FMovieThread.SXMovie := Self; |
FMovieThread.Resume; |
end; |
end; |
end; |
end; |
|
procedure TSXMovie.Stop; |
begin |
if not (csDesigning in ComponentState) then |
begin |
FPlaying := False; |
if Assigned(FMovieThread) then |
begin |
if not FMovieThread.Terminated then |
begin |
FMovieThread.Terminate; |
DoMovieEnd; |
end; |
FMovieThread.Free; |
FMovieThread := nil; |
end; |
if FDXSurface <> nil then |
begin |
FDXSurface.Free; |
FSurface := nil; |
end; |
end; |
end; |
|
constructor TSXMovie.Create(AOwner: TComponent); |
begin |
inherited Create(AOwner); |
FScreenRect := TScreenRect.Create; |
CoInitialize(nil); |
end; |
|
destructor TSXMovie.Destroy; |
begin |
if not (csDesigning in ComponentState) then |
begin |
FPlaying := False; |
if Assigned(FMovieThread) then |
begin |
if not FMovieThread.Terminated then |
FMovieThread.Terminate; |
FMovieThread.Free; |
FMovieThread := nil; |
end; |
if Assigned(FSample) then |
FSample := nil; |
if Assigned(FDDStream) then |
FDDStream := nil; |
if Assigned(FPrimaryVidStream) then |
FPrimaryVidStream := nil; |
if Assigned(FMMStream) then |
FMMStream := nil; |
if Assigned(FSurface) then |
FSurface := nil; |
end; |
FScreenRect.Free; |
CoUnInitialize; |
inherited; |
end; |
|
end. |
|