那里有videowindow的控件(100分)

那里有videowindow的控件,
就是用directshow编的多媒体播放器的例子中用到的那个控件

DSPack可在很多网站上下载

我自己写了一个控件，大部分是翻译的VC的范例，用到JEDI的DirectX翻译的头文件，下载
链接在里面标明了，注释写的很详细，应该没有什么问题吧

(* ------------------------------------------------------------------------- *)
(* DirectShowPlayer.pas by Dragon P.C. *)
(* ------------------------------------------------------------------------- *)
(* 1.0 beta *)
(* Dragon P.C. *)
(* 2001.10.20 *)
(* mailto:dragonpc@21cn.com *)

unit DSMediaPlayer;

{$R-,T-,H+,X+}

interface

uses
Windows, Classes, Forms, Controls, ActiveX, Dialogs, Messages, SysUtils,
[green](* DirectShow.pas - DirectX Header file, you cando
wnload from
http://www.delphi-jedi.org/DelphiGraphics/jedi-index.htm
or direct use (maybe bad linked now)
http://www.delphi-jedi.org/DelphiGraphics/directx/headers/DirectShow.zip
*)[/green] DirectShow

Const
{ Unique event identifier }
dsEventMessage = WM_APP + $1213;
dsEventInstance = 820;
// Dragon P.C.'s Birthday, Happy Birthday to me!!!

{ other const }
dsEventsOn : Integer = 0;
dsEventsOff : Integer = 1;
VolumeTable : Array[0..15] of Integer = (-10000, -6000, -4000, -2700, -1800, -1200, -750, -530, -350, -225, -150, -100, -75, -50, -30, 0);

{ When Create DirectShow Interface error occur }
sCreateInterfaceErrorCaption = 'DSPlayer';
sReaderErrorText = 'Unable to render the file';
sCreateInterfaceErrorText = 'Create DirectShow Interface Error!';

type
{ Player object status }
TDSPlayerStatus = (psClosed, psPlaying, psStopped, psPaused, psOpen);

TDSPlayer = class(TComponent)
private
{ Used to open the file and render the filters }
FdsGraphBuilder: IGraphBuilder;
{ Play, Stop, Pause }
FdsMediaControl: IMediaControl;
{ Set position }
FdsMediaSeeking: IMediaSeeking;
{ Volume/Balance control }
FdsBasicAudio: IBasicAudio;
{ Video source size }
FdsBasicVideo: IBasicVideo2;
{ Window positioning }
FdsVideoWindow: IVideoWindow;
{ Event handling }
FdsMediaEventEx: IMediaEventEx;
{ Owner Form Handle }
FOwnerHandle: HWND;
{ Display Control }
FDisplayControl: TWinControl;
{ Play State }
plState: TDSPlayerStatus;
{ Length of open media }
FMediaLength: Int64;
{ Used to draw the time bar }
FMediaPosition: Int64;
{ DisplayControl Callback method }
FDisplayControlWndProc,
FPrevDisplayControlWndProc : TFarProc;
{ DisplayControl Callback method }
procedure DisplayControlWndProc(var Message: TMessage);
{ Create DirectShow Interface }
function CreateMovieInterface : Boolean;
{ Destory all DirectShow Interface }
procedure DestroyMovieInterface;
{ Synchronize Video Window and DisplyControl view }
procedure ResetWindowPos;
{ Setting DisplayControl var }
procedure SetDisplayControl(wc: TWinControl);
{ DirectShow Event Handle }
procedure SetPlayerStatus(ps : TDSPlayerStatus);
procedure SetLength(length : Int64);
procedure DSEventMethod(var M: TMessage);
message dsEventMessage;
public
Constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure OpenMediaFile(const sFilename: string);
procedure Open();
procedure Stop();
procedure Play();
procedure Pause();
(* Ido
n't like use Property to change private data, so I publish follow *)
(* methods to change property. *)
function GetVolume : Integer;
procedure SetVolume(vLevel : Integer);
function GetCurrentPosition : Int64;
procedure SetCurrentPosition(mPos : Int64);
function GetLength(): Int64;
published
property DisplayControl: TWinControl read FDisplayControl write SetDisplayControl;
property PlayerStatus: TDSPlayerStatus read plState Write SetPlayerStatus;
property Length: Int64 read GetLength Write SetLength;
property Volume: Integer read GetVolume write SetVolume;
property Position: Int64 read GetCurrentPosition write SetCurrentPosition;
end;


procedure Register;

implementation

{ Register This Component into System VCL Component Palette }
procedure Register;
begin

RegisterComponents('System', [TDSPlayer]);
end;


{ TDSPlayer }

constructor TDSPlayer.Create(AOwner: TComponent);
begin

inherited;
FOwnerHandle := TForm(Owner).Handle;

// init DirectShow Interfaces
FdsGraphBuilder := nil;
FdsMediaControl := nil;
FdsMediaSeeking := nil;
FdsBasicAudio := nil;
FdsBasicVideo := nil;
FdsVideoWindow := nil;
FdsMediaEventEx := nil;

// init vars
plState := psClosed;
FMediaLength := -1;
FMediaPosition := 0;

while not CreateMovieInterface()do

if MessageBox(
FOwnerHandle,
PChar(sCreateInterfaceErrorText),
PChar(sCreateInterfaceErrorCaption),
MB_RETRYCANCEL + MB_ICONERROR + MB_DEFBUTTON1) = IDCANCEL
then
Break;
end;


destructor TDSPlayer.Destroy;
begin

try
DestroyMovieInterface();
except
end;

inherited;
end;


function TDSPlayer.CreateMovieInterface: Boolean;
begin

Result := False;
// Init COM Interface
If failed(CoInitialize(nil)) then
Exit;
// Create DirectShow Graph
if failed(CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC,IID_IGraphBuilder,FdsGraphBuilder)) then
Exit;
// Get the IMediaControl Interface
if failed(FdsGraphBuilder.QueryInterface(IID_IMediaControl,FdsMediaControl)) then
exit;
// Get the IMediaSeeking Interface
if failed(FdsGraphBuilder.QueryInterface(IID_IMediaSeeking,FdsMediaSeeking)) then
exit;
// Get the IBasicAudio Interface
if failed(FdsGraphBuilder.QueryInterface(IID_IBasicAudio,FdsBasicAudio)) then
exit;
// Get the IBasicWindow Interface
if failed(FdsGraphBuilder.QueryInterface(IID_IBasicVideo,FdsBasicVideo)) then
exit;
// Get the IVideoWindow Interface
if failed(FdsGraphBuilder.QueryInterface(IID_IVideoWindow,FdsVideoWindow)) then
exit;
// Get the IMediaEventEx Interface
if failed(FdsGraphBuilder.QueryInterface(IID_IMediaEventEx,FdsMediaEventEx)) then
exit;
// Attach the IMediaEventEx interface to the main window
// registers a window to process event notifications
if Failed(FdsMediaEventEx.SetNotifyWindow(FOwnerHandle, dsEventMessage, dsEventInstance)) then
exit;
// Enable IMediaEventEx notifications
FdsMediaEventEx.SetNotifyFlags(dsEventsOn);
Result := True;
end;


procedure TDSPlayer.DestroyMovieInterface;
var
I : Integer;
dsFilterEnum : IEnumFilters;
dsFilterCount : Integer;
dsFetched : uLong;
dsFilters : Array[0..49] of IBaseFilter;
begin

// Stop playback if we're trying to open a movie if one is already loaded.
If Assigned(FdsMediaControl) then
FdsMediaControl.Stop;

// Remove all filters
If Assigned(FdsGraphBuilder) then

begin

dsFilterEnum := nil;
dsFilterCount := 0;
I := 0;
If FdsGraphBuilder.EnumFilters(dsFilterEnum) = S_OK then

begin

// Count the currently active filters
While (dsFilterEnum.Skip(1) = S_OK)do
inc(dsFilterCount);
dsFilterEnum.Reset;
dsFetched := 0;

// Load the filters into an array
While (dsFilterEnum.Next(1, dsFilters,Addr(dsFetched)) = S_OK)do
Inc(I);

If Assigned(dsFilterEnum) then
dsFilterEnum := nil;

// Remove the filters from the graph
If dsFilterCount > 0 then
For I := 0 to dsFilterCount-1do

begin

FdsGraphBuilder.RemoveFilter(dsFilters);
dsFilters := nil;
end;

end;

end;


// Detach ownership to stop events
If Assigned(FdsVideoWindow) then

begin

FdsVideoWindow.put_Visible(false);
FdsVideoWindow.put_Owner(0);
end;


// Release all remaining pointers
if Assigned(FdsMediaControl) then
FdsMediaControl := nil;
if Assigned(FdsMediaSeeking) then
FdsMediaSeeking := nil;
if Assigned(FdsBasicAudio) then
FdsBasicAudio := nil;
if Assigned(FdsBasicVideo) then
FdsBasicVideo := nil;
if Assigned(FdsVideoWindow) then
FdsVideoWindow := nil;
if Assigned(FdsMediaEventEx) then
FdsMediaEventEx := nil;
if Assigned(FdsGraphBuilder) then
FdsGraphBuilder := nil;

// Clean up the COM interface
CoUninitialize;

plState := psClosed;
end;


procedure TDSPlayer.DSEventMethod(var M: TMessage);
var
dsEventCode : Integer;
dsEventParam1 : Integer;
dsEventParam2 : Integer;
begin

inherited;
if M.lParam = dsEventInstance then

begin

if Assigned(FdsMediaEventEx) then

begin

If FdsMediaEventEx.GetEvent(dsEventCode,dsEventParam1,dsEventParam2,10) <> E_Abort then

begin

case dsEventCode of
EC_COMPLETE:
begin

Stop();
plState := psStopped;
end;

// EC_ERRORABORT:
// ShowMessage('Error Abort');
// EC_VIDEO_SIZE_CHANGED:
// ShowMessage('Video Size Changed!');
end;


// Free the event from memory
FdsMediaEventEx.FreeEventParams(dsEventCode,dsEventParam1,dsEventParam2);
end;

end;

end;

end;


{ Media File Control }

procedure TDSPlayer.Open;
begin

with TOpenDialog.Create(Owner)do

begin

if Execute then
OpenMediaFile(FileName);
Free;
end;

end;


procedure TDSPlayer.OpenMediaFile(const sFilename: string);
var
UnicodeFileName : Array[0..(MAX_PATH*2)-1] of Char;
begin

If FileExists(sFilename) = True then

begin

// First clean the old movie interface
try
DestroyMovieInterface();
except
end;


If CreateMovieInterface() = True then

begin

// Get filename in UNICODE
MultiByteToWideChar(CP_ACP, 0, PChar(sFilename), -1, @UnicodeFileName, MAX_PATH);
// Render the file filters
If FdsGraphBuilder.RenderFile(@UnicodeFileName,nil) = S_OK then

begin

// First, setting volume = 7.
SetVolume(7);
// First, setting start of the media.
FMediaPosition := 0;
// Firest, setting object status.
plState := psOpen;
// Set FMediaLength var
If Assigned(FdsMediaSeeking) then
FdsMediaSeeking.GetDuration(FMediaLength);
// Set form as the owner
FdsVideoWindow.put_Owner(FOwnerHandle);
// Set the video window messages (mouse/keyboard) to be routed to form
FdsVideoWindow.put_MessageDrain(FOwnerHandle);
// Set the video window to be a child window of our form.
FdsVideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN);
// Set the inital window position
ResetWindowPos;
// Seek the video to the start and pause.
Stop();
end else

begin

ShowMessage(sReaderErrorText);
try
DestroyMovieInterface();
except
end;

end;

end
else

ShowMessage(sCreateInterfaceErrorText);
end;

end;


{ Video Window Display (TWinControl) Control }
(*
FDisplayControlWndProc
FPrevDisplayControlWndProc : TFarProc;
procedure DisplayControlWndProc(var Message: TMessage);
*)
procedure TDSPlayer.DisplayControlWndProc(var Message: TMessage);
begin

with Messagedo

begin

case Msg of
// WM_WINDOWPOSCHANGING,
// WM_WINDOWPOSCHANGED,
// WM_MOVE,
WM_SIZE: ResetWindowPos();
end;

Result := CallWindowProc(FPrevDisplayControlWndProc, FDisplayControl.Handle, Msg, wParam, lParam);
end;

end;


procedure TDSPlayer.ResetWindowPos;
begin

if (Assigned(FDisplayControl) and Assigned(FdsVideoWindow)) then

begin

// Seting Video Window Owner
FdsVideoWindow.Put_Owner(FDisplayControl.Handle);
// Seting Video Window Position
FdsVideoWindow.SetWindowPosition(0, 0, FDisplayControl.Width, FDisplayControl.Height);
end
else

FDisplayControl := nil;
end;


// Capture Owner WinControl's Windows Size change message.
procedure TDSPlayer.SetDisplayControl(wc: TWinControl);
begin

if Assigned(wc) then

begin

// Destory callback function first, free memory
if Assigned(FPrevDisplayControlWndProc) then

begin

try
SetWindowLong(FDisplayControl.Handle, GWL_WNDPROC, LongInt(FPrevDisplayControlWndProc));
FreeObjectInstance(FDisplayControlWndProc);
except
end;

end;


// make new callback handle to DisplayControl
FDisplayControl := wc;
FDisplayControlWndProc := MakeObjectInstance(DisplayControlWndProc);
FPrevDisplayControlWndProc := Pointer(GetWindowLong(FDisplayControl.Handle, GWL_WNDPROC));
SetWindowLong(FDisplayControl.Handle, GWL_WNDPROC, LongInt(FDisplayControlWndProc));
end
else

FDisplayControl := nil;
end;


{ Video Playing Control Methods }

function TDSPlayer.GetLength: Int64;
begin

result := FMediaLength
end;


function TDSPlayer.GetCurrentPosition: Int64;
var
CurPos : Int64;
StopPos : Int64;
// Not really used by this program
begin

// Default result in case of failure
Result := -1;
If Assigned(FdsMediaSeeking) then

If FdsMediaSeeking.GetPositions(CurPos, StopPos) = S_OK then
Result := CurPos;
end;


procedure TDSPlayer.SetCurrentPosition(mPos: Int64);
var
mStop : Int64;
begin

If Assigned(FdsMediaSeeking) then

begin

FdsMediaSeeking.GetStopPosition(mStop);

if mPos < 0 then
mPos := 0;
if mPos > mStop then
mPos := mStop;

FdsMediaSeeking.SetPositions(mPos, AM_SEEKING_AbsolutePositioning,mPos, AM_SEEKING_NoPositioning);
FMediaPosition := mPos;
end;

end;


// VolumeTable : Array[0..15] of Integer
function TDSPlayer.GetVolume: Integer;
var
i, nVolume: Integer;
begin

Result := -1;
If Assigned(FdsBasicAudio) then

begin

FdsBasicAudio.get_Volume(nVolume);
for i := 0 to 15do

begin

if (VolumeTable = nVolume) then

begin

Result := i;
Break;
end;

end;

end;

end;


// VolumeTable : Array[0..15] of Integer
procedure TDSPlayer.SetVolume(vLevel: Integer);
// 0 ~ 15
begin

If Assigned(FdsBasicAudio) and (vLevel >=0) and (vLevel < 16) then
FdsBasicAudio.Put_Volume(VolumeTable[vLevel]);
end;


procedure TDSPlayer.Play;
begin

If Assigned(FdsMediaControl) and (plState <> psClosed) then

begin

If (plState = psPaused) or (plState = psStopped) then

begin

FdsMediaControl.Run;
plState := psPlaying;
end;

end
else

FDisplayControl := nil;
end;


procedure TDSPlayer.Stop;
begin

If (plState <> psClosed) and (plState <> psStopped) then

begin

If Assigned(FdsMediaControl) then

begin

// Stop Playback
FdsMediaControl.Stop;
// Seek to First Frame
SetCurrentPosition(0);
// Pause Playback (brings up first image)
FdsMediaControl.Pause;
plState := psStopped;
end;

end;

end;


procedure TDSPlayer.Pause;
begin

If Assigned(FdsMediaControl) and (plState <> psClosed) then

begin

If (plState = psPlaying) then

begin

FdsMediaControl.Pause;
plState := psPaused;
end;

end;

end;


procedure TDSPlayer.SetLength(length: Int64);
begin

//
end;


procedure TDSPlayer.SetPlayerStatus(ps: TDSPlayerStatus);
begin

//
end;


end.

to:dragonpc_???
能否给一段DS的控制“原声”和“伴唱”的代码？谢谢了！