Subversion Repositories spacemission

Rev

Rev 4 | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. {
  2.  SXMedia  Components - Beta 1
  3.  --------------------------------
  4.  Copyright 1999 Dean Ellis
  5.  http://www.sillex.freeserve.co.uk
  6.  
  7.  This unit is part of the SXMedia Component Set. This code is
  8.  supplied as is with no guarantees and must be used at your own
  9.  risk.
  10.  
  11.  No modifications to this code must be made without the express
  12.  permission of the author. Please report any problems to
  13.  support@sillex.freeserve.co.uk
  14.  
  15.  You may use these components to create any freeware/shareware
  16.  applications that you wish. If the components are to be used in
  17.  a commercail product then credit for developement of these components
  18.  should be given.
  19.  
  20.  Credits :
  21.  
  22.  Developer : Dean Ellis
  23.  Testers   : Dominique Louis
  24.              Ivan Blecic
  25. }
  26. unit SXMovie;
  27.  
  28. {$INCLUDE DelphiXcfg.inc}
  29.  
  30. interface
  31.  
  32. uses
  33.   Windows, Classes, SysUtils, ActiveX, Math, Dialogs,
  34.   DXSounds, DXDraws,
  35.   {$IFDEF StandardDX}
  36.   DirectDraw, DirectSound, DirectShow9,
  37.     {$IFDEF DX7}
  38.       {$IFDEF D3DRM}
  39.   Direct3DRM,
  40.       {$ENDIF}
  41.   Direct3D;
  42.     {$ENDIF}
  43.     {$IFDEF DX9}
  44.   Direct3D9, Direct3D, D3DX9, {Direct3D8,} DX7toDX8;
  45.     {$ENDIF}
  46.   {$ELSE}
  47.   DShow, DirectX;
  48.   {$ENDIF}
  49.  
  50. type
  51.   TMovieOptions = (VideoAndSound, VideoOnly);
  52.   TDisplay = (FullScreen, WideScreen, OriginalSize);
  53.  
  54.   TScreenRect = class(TPersistent)
  55.   private
  56.     FLeft: integer;
  57.     FRight: integer;
  58.     FTop: integer;
  59.     FBottom: integer;
  60.     procedure SetLeft(Value: integer);
  61.     procedure SetRight(Value: integer);
  62.     procedure SetTop(Value: integer);
  63.     procedure SetBottom(Value: integer);
  64.   protected
  65.   public
  66.     procedure Assign(Value: TScreenRect); reintroduce;
  67.   published
  68.     property Left: integer read FLeft write SetLeft;
  69.     property Right: integer read FRight write SetRight;
  70.     property Top: integer read FTop write SetTop;
  71.     property Bottom: integer read FBottom write SetBottom;
  72.   end;
  73.  
  74.  
  75.   TSXMovie = class;
  76.  
  77.   TMovieThread = class(TThread)
  78.   private
  79.     { Private declarations }
  80.     FSXMovie: TSXMovie;
  81.   protected
  82.     procedure Execute; override;
  83.   public
  84.     property SXMovie: TSXMovie read FSXMovie write FSXMovie;
  85.   end;
  86.  
  87.   TSXMovie = class(TComponent)
  88.   private
  89.     FMovieThread: TMovieThread;
  90.     FDXDraw: TDXDraw;
  91.     FDXSound: TDXSound;
  92.     FMMStream: IMultiMediaStream;
  93.     FPrimaryVidStream: IMediaStream;
  94.     FDDStream: IDirectDrawMediaStream;
  95.     FSample: IDirectDrawStreamSample;
  96.     FSurface: IDirectDrawSurface;
  97.     FDXSurface: TDirectDrawSurface;
  98.     FRect: TRect;
  99.     FDestRect: TRect;
  100.     FScreenRect: TScreenRect;
  101.     FFilename: TFilename;
  102.     FPlaying: Boolean;
  103.     FDoFlip: Boolean;
  104.     {Event}
  105.     FOnMovieEnd: TNotifyEvent;
  106.     FOnBeforeRender: TNotifyEvent;
  107.     FOnAfterRender: TNotifyEvent;
  108.     procedure SetFilename(Value: TFilename);
  109.     procedure SetScreenRect(Value: TScreenRect);
  110.     procedure DoMovieEnd;
  111.     procedure DoBeforeRender;
  112.     procedure DoAfterRender;
  113.   protected
  114.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  115.     procedure SetMovieStateRun;
  116.     procedure SetMovieStateStop;
  117.     procedure CreateMediaStream; virtual;
  118.     procedure SetupMediaSample; virtual;
  119.   public
  120.     constructor Create(AOwner: TComponent); override;
  121.     destructor Destroy; override;
  122.     procedure UpDate; virtual;
  123. //    function SetDisplay(Value:TDisplay):Boolean;
  124.     procedure DisplayRect(Top, Left, Right, Bottom: integer);
  125.     procedure Play;
  126.     procedure Stop;
  127.     {}
  128.   published
  129.     property DXDraw: TDXDraw read FDXDraw write FDXDraw;
  130.     property DXSound: TDXSound read FDXSound write FDXSound;
  131.     property Filename: TFilename read FFilename write SetFilename;
  132.     property Playing: Boolean read FPlaying;
  133.     property DoFlip: Boolean read FDoFlip write FDoFlip;
  134.     property DestinationRectangle: TScreenRect read FScreenRect write SetScreenRect;
  135.     property OnMovieEnd: TNotifyEvent read FOnMovieEnd write FOnMovieEnd;
  136.     property OnBeforeRender: TNotifyEvent read FOnBeforeRender write FOnBeforeRender;
  137.     property OnAfterRender: TNotifyEvent read FOnAfterRender write FOnAfterRender;
  138.   end;
  139.  
  140. implementation
  141.  
  142. uses Graphics;
  143.  
  144. procedure TScreenRect.SetLeft(Value: integer);
  145. begin
  146.   FLeft := Value;
  147. end;
  148.  
  149. procedure TScreenRect.SetRight(Value: integer);
  150. begin
  151.   FRight := Value;
  152. end;
  153.  
  154. procedure TScreenRect.SetTop(Value: integer);
  155. begin
  156.   FTop := Value;
  157. end;
  158.  
  159. procedure TScreenRect.SetBottom(Value: integer);
  160. begin
  161.   FBottom := Value;
  162. end;
  163.  
  164. procedure TScreenRect.Assign(Value: TScreenRect);
  165. begin
  166.   Left := Value.Left;
  167.   Right := Value.Right;
  168.   Top := Value.Top;
  169.   Bottom := Value.Bottom;
  170. end;
  171.  
  172. { Important: Methods and properties of objects in VCL can only be used in a
  173.   method called using Synchronize, for example,
  174.  
  175.       Synchronize(UpdateCaption);
  176.  
  177.   and UpdateCaption could look like,
  178.  
  179.     procedure TMovieThread.UpdateCaption;
  180.     begin
  181.       Form1.Caption := 'Updated in a thread';
  182.     end; }
  183.  
  184. { TMovieThread }
  185.  
  186. procedure TMovieThread.Execute;
  187. begin
  188.   { Place thread code here }
  189.   if Assigned(SXMovie) then
  190.     SXMovie.SetMovieStateRun;
  191.   while (not Terminated) and Assigned(SXMovie) do
  192.   begin
  193.     Synchronize(SXMovie.UpDate)
  194.   end;
  195.   if Assigned(SXMovie) then
  196.     SXMovie.SetMovieStateStop;
  197. end;
  198.  
  199. {SXMovie}
  200.  
  201. procedure TSXMovie.SetFilename(Value: TFilename);
  202. begin
  203.   if Value <> '' then
  204.     FFilename := Value;
  205. end;
  206.  
  207. procedure TSXMovie.SetScreenRect(Value: TScreenRect);
  208. begin
  209.   FScreenRect.Assign(Value);
  210. end;
  211.  
  212. procedure TSXMovie.DoMovieEnd;
  213. begin
  214.   if Assigned(FOnMovieEnd) then FOnMovieEnd(Self);
  215. end;
  216.  
  217. procedure TSXMovie.DoBeforeRender;
  218. begin
  219.   if Assigned(FOnBeforeRender) then FOnBeforeRender(Self);
  220. end;
  221.  
  222. procedure TSXMovie.DoAfterRender;
  223. begin
  224.   if Assigned(FOnAfterRender) then FOnAfterRender(Self);
  225. end;
  226.  
  227. procedure TSXMovie.Notification(AComponent: TComponent; Operation: TOperation);
  228. begin
  229.   if Operation = opRemove then
  230.   begin
  231.     if AComponent is TDXDraw then FDXDraw := nil;
  232.     if AComponent is TDXSound then FDXSound := nil;
  233.   end;
  234.   inherited;
  235. end;
  236.  
  237. procedure TSXMovie.SetMovieStateRun;
  238. begin
  239.   try
  240.     if FMMStream.SetState(STREAMSTATE_RUN) <> S_OK then
  241.       Exception.Create('Set Movie State Run Exception');
  242.   except
  243.   end;
  244. end;
  245.  
  246. procedure TSXMovie.SetMovieStateStop;
  247. begin
  248.   try
  249.     FMMStream.SetState(STREAMSTATE_STOP);
  250.   finally
  251.     FPlaying := False;
  252.   end;
  253. end;
  254.  
  255. procedure TSXMovie.CreateMediaStream;
  256. var
  257.   wPath:{$IFDEF UNICODE}string{$ELSE}array[0..MAX_PATH] of WChar{$ENDIF};
  258.   AMStream:IAMMultiMediaStream;
  259.   Media:IMediaStream;
  260. begin
  261.    Media := nil;
  262.    AMStream := nil;
  263.    try
  264.       CoCreateinstance(CLSID_AMMULTIMEDIASTREAM,nil,CLSCTX_INPROC_SERVER,IID_IAMMULTIMEDIASTREAM,AMStream);
  265.       {$IFDEF UNICODE}
  266.       wPath := Filename;
  267.       {$ELSE}
  268.       MultiByteToWideChar(CP_ACP,0,PAnsiChar(Filename),-1,wPath,Sizeof(wPAth) div sizeof(wPath[0]));
  269.       {$ENDIF}
  270.       AMStream.Initialize(STREAMTYPE_READ,AMMSF_NOGRAPHTHREAD,nil);
  271.       if (DXSound <> nil) and (DXSound.DSound <> nil) and (DXSound.DSound.ISound <> nil) then
  272.          AMStream.AddMediaStream(DXSound.DSound.ISound,{$IFDEF UNICODE}{$IFNDEF D26UP}@{$ENDIF}{$ENDIF}MSPID_PrimaryAudio,AMMSF_ADDDEFAULTRENDERER,IMediaStream(nil^));
  273.       AMStream.AddMediaStream(DXDraw.DDraw.IDraw,{$IFDEF UNICODE}{$IFNDEF D26UP}@{$ENDIF}{$ENDIF}MSPID_PrimaryVideo,0,Media);
  274.       AMStream.OpenFile({$IFDEF UNICODE}@wPAth[1]{$ELSE}wPAth{$ENDIF},0);
  275.       FMMStream := AMStream;
  276.    except
  277.       FMMStream := nil;
  278.    end;
  279. end;
  280.  
  281. procedure TSXMovie.SetupMediaSample;
  282. begin
  283.   try
  284.     FSample := nil;
  285.     FDDStream := nil;
  286.     FPrimaryVidStream := nil;
  287.     if FMMStream.GetMediaStream(MSPID_PrimaryVideo, FPrimaryVidStream) <> S_OK then Exit;
  288.     if FPrimaryVidStream.QueryInterface(IID_IDirectDrawMediaStream, FDDStream) <> S_OK then Exit;
  289.     if FDDStream.CreateSample(nil, PRect(nil)^, 0, FSample) <> S_OK then Exit;
  290.     FDXSurface := TDirectDrawSurface.Create(FDXDraw.DDraw);
  291.     if FSample.GetSurface(FSurface, FRect) <> S_OK then Exit;
  292.     FDXSurface.IDDSurface := FSurface;
  293.   except
  294.  
  295.   end;
  296. end;
  297.  
  298. procedure TSXMovie.UpDate;
  299.   function AspectRatio(SourceRect: TRect; var DestRect: TRect): Boolean;
  300.   var
  301.     SourceWidth, SourceHeight, DestWidth, DestHeight: Integer;
  302.     SourceRatio, DestRatio: Double;
  303.   begin
  304.     Result := False;
  305.     SourceWidth := SourceRect.Right - SourceRect.Left;
  306.     SourceHeight := SourceRect.Bottom - SourceRect.Top;
  307.     SourceRatio := SourceWidth/SourceHeight;
  308.  
  309.     DestWidth := DestRect.Right - DestRect.Left;
  310.     DestHeight := DestRect.Bottom - DestRect.Top;
  311.     DestRatio := DestWidth/DestHeight;
  312.     if SourceRatio <> DestRatio  then
  313.     begin
  314.       if DestWidth > DestHeight then
  315.         DestRect.Bottom := DestRect.Top + Round(DestWidth / SourceRatio)
  316.       else
  317.         DestRect.Right := DestRect.Left + Round(SourceRatio * DestHeight);
  318.       Result := True;
  319.     end;
  320.   end;
  321. var
  322.   R: TRect;
  323.   Q: HResult;
  324. begin
  325.   try
  326.     Q := FSample.Update(0, 0, nil, 0);
  327.     case Q of
  328.       HResult(MS_S_PENDING):;
  329.       HResult(MS_S_NOUPDATE):;
  330.       HResult(MS_S_ENDOFSTREAM):;
  331.     end;
  332.     if Q <> S_OK then
  333.     begin
  334.       FMovieThread.Terminate;
  335.       SetMovieStateStop;
  336.       FPlaying := False;
  337.       DoMovieEnd;
  338.       Exit;
  339.     end;
  340.     if (FSurface <> nil) and DXDraw.CanDraw then
  341.     begin
  342.       DoBeforeRender;
  343.       R := FDestRect;
  344.       if AspectRatio(FRect, R) then
  345.         FDestRect := R;
  346.       DXDraw.Surface.StretchDraw(FDestRect, FRect, FDXSurface, False);
  347.       with DXDraw.Surface.Canvas do
  348.       begin
  349.         Brush.Style := bsClear;
  350.         Font.Color := clWhite;
  351.         Font.Size := 8;
  352.         Textout(5, 5, 'SilleX Media - Beta 1');
  353.         Release;
  354.       end;
  355.       DoAfterRender;
  356.       if DoFlip then
  357.         DXDraw.Flip;
  358.     end;
  359.   except
  360.     on E: Exception do
  361.       ShowMessage(E.Message);
  362.   end;
  363. end;
  364.  
  365. procedure TSXMovie.DisplayRect(Top, Left, Right, Bottom: integer);
  366. begin
  367.   if not (csDesigning in ComponentState) then
  368.   begin
  369.     FScreenRect.Top := Top;
  370.     FSCreenRect.Left := Left;
  371.     FScreenRect.Right := Right;
  372.     FScreenRect.Bottom := Bottom;
  373.   end;
  374. end;
  375.  
  376. procedure TSXMovie.Play;
  377. begin
  378.   if not (csDesigning in ComponentState) then
  379.   begin
  380.     FDestRect.Left := FScreenRect.Left;
  381.     FDestRect.Right := FScreenRect.Right;
  382.     FDestRect.Top := FScreenRect.Top;
  383.     FDestRect.Bottom := FScreenRect.Bottom;
  384.     FPlaying := True;
  385.     CreateMediaStream;
  386.     SetupMediaSample;
  387.     if FSample <> nil then
  388.     begin
  389.       FMovieThread := TMovieThread.Create(True);
  390.       if Assigned(FMovieThread) then
  391.       begin
  392.         FMovieThread.FreeOnTerminate := False;
  393.         FMovieThread.SXMovie := Self;
  394.         FMovieThread.Resume;
  395.       end;
  396.     end;
  397.   end;
  398. end;
  399.  
  400. procedure TSXMovie.Stop;
  401. begin
  402.   if not (csDesigning in ComponentState) then
  403.   begin
  404.     FPlaying := False;
  405.     if Assigned(FMovieThread) then
  406.     begin
  407.       if not FMovieThread.Terminated then
  408.       begin
  409.         FMovieThread.Terminate;
  410.         DoMovieEnd;
  411.       end;
  412.       FMovieThread.Free;
  413.       FMovieThread := nil;
  414.     end;
  415.     if FDXSurface <> nil then
  416.     begin
  417.       FDXSurface.Free;
  418.       FSurface := nil;
  419.     end;
  420.   end;
  421. end;
  422.  
  423. constructor TSXMovie.Create(AOwner: TComponent);
  424. begin
  425.   inherited Create(AOwner);
  426.   FScreenRect := TScreenRect.Create;
  427.   CoInitialize(nil);
  428. end;
  429.  
  430. destructor TSXMovie.Destroy;
  431. begin
  432.   if not (csDesigning in ComponentState) then
  433.   begin
  434.     FPlaying := False;
  435.     if Assigned(FMovieThread) then
  436.     begin
  437.       if not FMovieThread.Terminated then
  438.         FMovieThread.Terminate;
  439.       FMovieThread.Free;
  440.       FMovieThread := nil;
  441.     end;
  442.     if Assigned(FSample) then
  443.       FSample := nil;
  444.     if Assigned(FDDStream) then
  445.       FDDStream := nil;
  446.     if Assigned(FPrimaryVidStream) then
  447.       FPrimaryVidStream := nil;
  448.     if Assigned(FMMStream) then
  449.       FMMStream := nil;
  450.     if Assigned(FSurface) then
  451.       FSurface := nil;
  452.   end;
  453.   FScreenRect.Free;
  454.   CoUnInitialize;
  455.   inherited;
  456. end;
  457.  
  458. end.
  459.  
  460.