Include file for native Directshow support in PB4

Developed or developing a new product in PureBasic? Tell the world about it.
Zach
Addict
Addict
Posts: 1654
Joined: Sun Dec 12, 2010 12:36 am
Location: Somewhere in the midwest
Contact:

Re: Include file for native Directshow support in PB4

Post by Zach »

You'll probably want to build a custom graph then, and use Transform filters between your input filter and render output filter.

Although honestly, I don't know that much about DirectShow, else I'd be using it too, instead of The Avifile API.

I hope this can help you out, although its in C++ (The rest of The Internet sure doesn't make it easy for us PB users!)

Directshow For Media Playback in Windows
Image
AndyMK
Enthusiast
Enthusiast
Posts: 540
Joined: Wed Jul 12, 2006 4:38 pm
Location: UK

Re: Include file for native Directshow support in PB4

Post by AndyMK »

Looks like an absolute nightmare and way over my head :| but thanks for the info
bombseb
New User
New User
Posts: 9
Joined: Sat Sep 16, 2006 12:54 pm
Location: Réunion Island

Re: Include file for native Directshow support in PB4

Post by bombseb »

Hi there !

great work, great lib !
is it possible to render à vidéo in a sprite with your lib ?
novablue
Enthusiast
Enthusiast
Posts: 165
Joined: Sun Nov 27, 2016 6:38 am

Re: Include file for native Directshow support in PB4

Post by novablue »

Hi, i am still using this as a module for many of my projects, it works great when compiled as x86 hower x64 gives me ima's, if someone could make this work for x64 it would be great.

Code: Select all

EnableExplicit

DeclareModule DshowMedia
	#VMR9_Windowed       = 1 << 0
	#VMR9_Windowless     = 1 << 1
	#VMR7_Windowed       = 1 << 2
	#VMR7_Windowless     = 1 << 3
	#OldVideoRenderer    = 1 << 4
	#OverlayMixer        = 1 << 5
	
	#WaveOutRenderer     = 1 << 6
	#DirectSoundRenderer = 1 << 7
	
	#VMR7_ForceOverlays  = 1 << 8
	#VMR7_ForceOffscreen = 1 << 9
	#DontKeepAR          = 1 << 10
	
	Enumeration ; MediaState
		#State_Stopped
		#State_Paused
		#State_Running
	EndEnumeration
	
	Enumeration ; MediaInfo
		#MEDIA_LENGTH
		#MEDIA_FPS
		#MEDIA_WIDTH
		#MEDIA_HEIGHT
		#MEDIA_POSITION
		#MEDIA_ASPECTRATIO_NUM
		#MEDIA_ASPECTRATIO_DEN
		#MEDIA_ASPECTRATIO
		#MEDIA_STATE
		#MEDIA_TIME_FRAMES
		#MEDIA_TIME_MSECS
	EndEnumeration
	
	Enumeration ; MediaSeeking
		#AM_SEEKING_NoPositioning
		#AM_SEEKING_AbsolutePositioning
	EndEnumeration

	Declare.i Resize(Object.i, x.i = #PB_Default, y.i = #PB_Default, width.i = #PB_Default, height.i = #PB_Default, keepAR.i = #True)
	Declare.i Load(Object.i, filename.s, Parent=0, flags.i = #VMR7_Windowed)
	Declare.i Play(Object.i)
	Declare.i Pause(Object.i)
	Declare.i Seek(Object.i, pos.q, SeekByFrame.i=#False)
	Declare.i Stop(Object.i)
	Declare.i Lenght(Object.i, mode.i = #MEDIA_TIME_MSECS)
	Declare.i Width(Object.i)
	Declare.i Height(Object.i)
	Declare.i ToggleFullscreen(Object.i)
	Declare.i Position(Object.i, mode.i = #MEDIA_TIME_MSECS)
	Declare.i State(Object.i)
	Declare.f FPS(Object.i) ; return .f cause we just need float precision
	Declare.i CaptureCurrMediaImage(Object.i, ResultingImgNo.i)
	Declare.i OnMediaEvent(Object.i)
	Declare.s Time2String(time.i)
	Declare.i GetVolume(Object.i) ; from -100db to 0db
	Declare.i PutVolume(Object.i, db.i) ; from -100db to 0db
	Declare.i PutBalance(Object.i, bal.i) ; -100 to +100
	Declare.i GetBalance(Object.i) ; from -100 to +100
	Declare.i Close(Object.i)
	Declare.i IsMedia(Object.i)

	Declare.i CreateInstance()
	Declare.i FreeInstance(Object.i)
EndDeclareModule

Module DshowMedia 
	
	EnableExplicit
	
	#VMRMode_Windowed   = $1
	#VMRMode_Windowless = $2
	#VMRMode_Renderless = $4
	#VMRMode_Mask       = $7
	
	#S_OK  = 0
	#OATRUE = -1
	#OAFALSE = 0
	
	#CLSCTX_INPROC_SERVER  = $01
	#CLSCTX_INPROC_HANDLER = $02
	#CLSCTX_LOCAL_SERVER   = $04
	#CLSCTX_REMOTE_SERVER  = $10
	
	#CLSCTX_ALL    = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
	#CLSCTX_INPROC = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER
	#CLSCTX_SERVER = #CLSCTX_INPROC_SERVER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
	
	#MAX_FILTER_NAME = 128
	
	#WM_GRAPHEVENT = #WM_USER+1
	
	#EC_COMPLETE  = 1
	
	#RenderPrefs_ForceOffscreen               = $00000001
	#RenderPrefs_ForceOverlays                = $00000002
	#RenderPrefs_AllowOverlays                = $00000000
	#RenderPrefs_AllowOffscreen               = $00000000
	#RenderPrefs_DoNotRenderColorKeyAndBorder = $00000008
	#RenderPrefs_RestrictToInitialMonitor     = $00000010
	#RenderPrefs_PreferAGPMemWhenMixing       = $00000020
	#RenderPrefs_Mask                         = $0000003F
	
	#Default = 0
	
	Interface IGraphBuilder_forceUnicode
		QueryInterface(a, b)
		AddRef()
		Release()
		AddFilter(a, b.p-unicode)
		RemoveFilter(a)
		EnumFilters(a)
		FindFilterByName(a.p-unicode, b)
		ConnectDirect(a, b, c)
		Reconnect(a)
		Disconnect(a)
		SetDefaultSyncSource()
		Connect(a, b)
		Render(a)
		RenderFile(a.p-unicode, b)
		AddSourceFilter(a.p-unicode, b.p-unicode, c)
		SetLogFile(a)
		Abort()
		ShouldOperationContinue()
	EndInterface
	
	Structure Dshow_Interfaces
		Object.i
		pGraphBuilder.IGraphBuilder_forceUnicode
		pControl.IMediaControl
		pEvent.IMediaEventEx
		pWindow.IVideoWindow
		pAudio.IBasicAudio
		pVideo.IBasicVideo2
		pSeeking.IMediaSeeking
		thread.i
		fullscreen.i
		hwnd.i
		drain.i
		aspectRatio.f
		width.i
		widthPAR.i
		height.i
		renderer.i
	EndStructure
	
	CompilerIf Defined(FILTER_INFO, #PB_Structure) = #False
		Structure FILTER_INFO ; an official Dshow structure - actually missing in PB
			achName.w[#MAX_FILTER_NAME]
			*pGraph.IFilterGraph
		EndStructure
	CompilerEndIf
	
	CompilerIf Defined(CAUUID, #PB_Structure) = #False
		Structure CAUUID
			cElems.i
			*pElems 
		EndStructure
	CompilerEndIf
	
	CompilerIf Defined(IEnumFilters, #PB_Interface) = #False
		Interface IEnumFilters
			QueryInterface(a, b)
			AddRef()
			Release()
			Next(a, b, c) ;{
			Skip(a)
			Reset()
			Clone(a)
		EndInterface
	CompilerEndIf

	Macro FAILED(Status)
		Status < 0
	EndMacro
	
	Macro SUCCEEDED(Status)
		Status >= 0
	EndMacro
	
	Macro _SafeRelease(__Object)
		If __Object
			__Object\Release()
			__Object = #Null
		EndIf
	EndMacro
	
	Macro _GetMediaObject(_Object_)
		Protected _Object_#.Dshow_Interfaces = Object_GetObject(g_DshowObjects, Object)
		If Not _Object_#
			Debug "Fatal Error: The given media no. hasn't been initialized!"
			CallDebugger
			ProcedureReturn #False
		EndIf
	EndMacro
	
	Macro CHECK_(in)
		CompilerIf #PB_Compiler_Debugger
			If Not SUCCEEDED(in#)
				Debug "Not succeeded at line " + Str(#PB_Compiler_Line)
				CallDebugger
			EndIf
		CompilerElse
			in#
		CompilerEndIf
	EndMacro
	
	Macro DEFINE_GUID(name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
		Global name.GUID
		name\Data1 = l
		name\Data2 = w1
		name\Data3 = w2
		name\Data4[0] = b1
		name\Data4[1] = b2
		name\Data4[2] = b3
		name\Data4[3] = b4
		name\Data4[4] = b5
		name\Data4[5] = b6
		name\Data4[6] = b7
		name\Data4[7] = b8
	EndMacro
	
	;{ GUIDS
	DEFINE_GUID(IID_IGraphBuilder,          $56A868A9, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
	DEFINE_GUID(IID_IMediaControl,          $56A868B1, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
	DEFINE_GUID(IID_IMediaEventEx,          $56A868C0, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
	DEFINE_GUID(IID_IMediaSeeking,          $36B73880, $C2C8, $11CF, $8B, $46, $00, $80, $5F, $6C, $EF, $60)
	DEFINE_GUID(IID_IVideoWindow,           $56A868B4, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
	DEFINE_GUID(IID_IBasicAudio,            $56A868B3, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
	DEFINE_GUID(IID_IBasicVideo,            $56A868B5, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
	DEFINE_GUID(IID_IMediaSeeking,          $36B73880, $C2C8, $11CF, $8B, $46, $00, $80, $5F, $6C, $EF, $60)
	DEFINE_GUID(IID_IBaseFilter,            $56A86895, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
	DEFINE_GUID(IID_IVMRFilterConfig9,      $5A804648, $4F66, $4867, $9C, $43, $4F, $5C, $82, $2C, $F1, $B8)
	DEFINE_GUID(IID_IVMRWindowlessControl9, $8F537D09, $F85E, $4414, $B2, $3B, $50, $2E, $54, $C7, $99, $27)
	DEFINE_GUID(IID_IVMRFilterConfig,       $9E5530C5, $7034, $48B4, $BB, $46, $0B, $8A, $6E, $FC, $8E, $36)
	DEFINE_GUID(IID_IVMRWindowlessControl,  $0EB1088C, $4DCD, $46F0, $87, $8F, $39, $DA, $E8, $6A, $51, $B7)
	DEFINE_GUID(IID_IVMRAspectRatioControl, $EDE80B5C, $BAD6, $4623, $B5, $37, $65, $58, $6C, $9F, $8D, $FD)
	DEFINE_GUID(IID_IVMRAspectRatioControl9,$00D96C29, $BBDE, $4EFC, $99, $01, $BB, $50, $36, $39, $21, $46)
	DEFINE_GUID(IID_ISpecifyPropertyPages,  $B196B28B, $BAB4, $101A, $B6, $9C, $00, $AA, $00, $34, $1D, $07)
	DEFINE_GUID(IID_IUnknown,               $00000000, $0000, $0000, $C0, $00, $00, $00, $00, $00, $00, $46)
	
	DEFINE_GUID(IID_IDvdGraphBuilder,       $FCC152B6, $F372, $11D0, $8E, $00, $00, $C0, $4F, $D7, $C0, $8B)
	DEFINE_GUID(IID_IDvdControl2,           $33BC7430, $EEC0, $11D2, $82, $01, $00, $A0, $C9, $D7, $48, $42)
	DEFINE_GUID(IID_IDvdInfo2,              $34151510, $EEC0, $11D2, $82, $01, $00, $A0, $C9, $D7, $48, $42)
	
	DEFINE_GUID(CLSID_FilterGraph,          $E436EBB3, $524F, $11CE, $9F, $53, $00, $20, $AF, $0B, $A7, $70)
	DEFINE_GUID(CLSID_VideoMixingRenderer,  $B87BEB7B, $8D29, $423F, $AE, $4D, $65, $82, $C1, $01, $75, $AC)
	DEFINE_GUID(CLSID_VideoMixingRenderer9, $51B4ABF3, $748F, $4E3B, $A2, $76, $C8, $28, $33, $0E, $92, $6A)
	DEFINE_GUID(CLSID_OverlayMixer,         $CD8743A1, $3736, $11D0, $9E, $69, $00, $C0, $4F, $D7, $C1, $5B)
	DEFINE_GUID(CLSID_VideoRenderer,        $70E102B0, $5556, $11CE, $97, $C0, $00, $AA, $00, $55, $59, $5A)
	DEFINE_GUID(CLSID_AudioRender,          $E30629D1, $27E5, $11CE, $87, $5D, $00, $60, $8C, $B7, $80, $66)
	DEFINE_GUID(CLSID_DSoundRender,         $79376820, $07D0, $11CF, $A2, $4D, $00, $20, $AF, $D7, $97, $67)
	DEFINE_GUID(TIME_FORMAT_MEDIA_TIME,     $7B785574, $8C82, $11CF, $BC, $0C, $00, $AA, $00, $AC, $74, $F6)
	DEFINE_GUID(TIME_FORMAT_FRAME,          $7B785570, $8C82, $11CF, $BC, $0C, $00, $AA, $00, $AC, $74, $F6)
	;}
	
	Import "ObjectManager.lib"
		CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
			Object_GetOrAllocateID(*Objects, Object.i) As "_PB_Object_GetOrAllocateID@8"
			Object_GetObject(*Objects, Object.i) As "_PB_Object_GetObject@8"
			Object_IsObject(*Objects, Object.i) As "_PB_Object_IsObject@8"
			Object_FreeID(*Objects, Object.i) As "_PB_Object_FreeID@8"
			Object_Init(structuresize.i, IncrementStep.i, *ObjectFreeFunction) As "_PB_Object_Init@12"
		CompilerElse
			Object_GetOrAllocateID(*Objects, Object.i) As "PB_Object_GetOrAllocateID"
			Object_GetObject(*Objects, Object.i) As "PB_Object_GetObject"
			Object_IsObject(*Objects, Object.i) As "PB_Object_IsObject"
			Object_FreeID(*Objects, Object.i) As "PB_Object_FreeID"
			Object_Init(structuresize.i, IncrementStep.i, *ObjectFreeFunction) As "PB_Object_Init"
		CompilerEndIf
	EndImport:IsWindow(#PB_Any)
	
	Global g_DshowObjects.i
	Global g_MediaFullscreen.b
	Global NewList filters.s()
	
	; Private Procedures
	
	Procedure _DeleteInterfaces(Object.i)
		_GetMediaObject(*object)
		_SafeRelease(*object\pControl)
		_SafeRelease(*object\pEvent)
		_SafeRelease(*object\pWindow)
		_SafeRelease(*object\pAudio)
		_SafeRelease(*object\pVideo)
		_SafeRelease(*object\pSeeking)
		_SafeRelease(*object\pGraphBuilder)
		ProcedureReturn #True
	EndProcedure
	
	Procedure _BuildInterfaces(Object.i)
		_GetMediaObject(*object)
		Protected a.i, b.i, c.i, d.i, e.i, f.i
		If Not CoCreateInstance_(@CLSID_FilterGraph, #Null, #CLSCTX_INPROC_SERVER, @IID_IGraphBuilder, @*object\pGraphBuilder) = #S_OK
			Debug "Error: Couldn't initialize the GraphBuilder Interface"
			CallDebugger
			ProcedureReturn #False
		Else
			*object\Object = #True
			a = *object\pGraphBuilder\QueryInterface(@IID_IMediaControl, @*object\pControl)
			b = *object\pGraphBuilder\QueryInterface(@IID_IMediaEventEx, @*object\pEvent)
			c = *object\pGraphBuilder\QueryInterface(@IID_IVideoWindow,  @*object\pWindow)
			d = *object\pGraphBuilder\QueryInterface(@IID_IBasicAudio,   @*object\pAudio)
			e = *object\pGraphBuilder\QueryInterface(@IID_IBasicVideo,   @*object\pVideo)
			f = *object\pGraphBuilder\QueryInterface(@IID_IMediaSeeking, @*object\pSeeking)
			If SUCCEEDED(a) And SUCCEEDED(b) And SUCCEEDED(c) And SUCCEEDED(d) And SUCCEEDED(e) And SUCCEEDED(f) ; Quick check
				ProcedureReturn #True
			Else
				_DeleteInterfaces(Object)
				Debug "Error: Query of at least one of the needed Interfaces failed"
				CallDebugger
				ProcedureReturn #False
			EndIf
		EndIf
	EndProcedure
	
	Procedure MoveWindow()
		If Not g_MediaFullscreen
			ReleaseCapture_()
			SendMessage_(GetForegroundWindow_(), #WM_SYSCOMMAND, #SC_MOVE + #HTCAPTION, 0)
		EndIf
	EndProcedure
	
	Procedure ToggleCursorFullscreen(*object.Dshow_Interfaces)
		Protected res.i, x.i = WindowMouseX(0), y.i = WindowMouseY(0), button.i, cursor.i = #True, reset.i = ElapsedMilliseconds(), KeyStroke.INPUT
		Repeat
			Delay(100)
			If g_MediaFullscreen
				If cursor
					If ElapsedMilliseconds() - reset > 2 * 1000 ; 2 Secs.
						*object\pWindow\HideCursor(#OATRUE)
						KeyStroke\type = #INPUT_MOUSE
						KeyStroke\mi\dwFlags = #MOUSEEVENTF_LEFTDOWN
						SendInput_(1, @KeyStroke, SizeOf(INPUT))
						cursor = #False
					EndIf
				EndIf
				If WindowMouseX(0) <> x Or WindowMouseY(0) <> y
					x = WindowMouseX(0)
					y = WindowMouseY(0)
					reset = ElapsedMilliseconds()
					If Not cursor
						*object\pWindow\HideCursor(#OAFALSE)
						cursor = #True
					EndIf
				EndIf
			EndIf
		ForEver
	EndProcedure
	
	Procedure GetFilterProperties(Object.i, filterName.s)
		_GetMediaObject(*object) 
		Protected *pFilter.IBaseFilter, *pProp.ISpecifyPropertyPages, FilterInfo.FILTER_INFO, *pFilterUnk.IUnknown, caGUID.CAUUID
		If *object\pGraphBuilder\FindFilterByName(filterName,  @*pFilter) = #S_OK : Debug "1"
			If *pFilter\QueryInterface(@IID_ISpecifyPropertyPages, @*pProp) = #S_OK : Debug "2"
				*pFilter\QueryFilterInfo(@FilterInfo) : Debug "3"
				*pFilter\QueryInterface(@IID_IUnknown, @*pFilterUnk) : Debug "4"
				*pProp\GetPages(@caGUID) : Debug "5"
				*pProp\Release() : Debug "6"
				OleCreatePropertyFrame_(*object\hwnd, 0, 0, @FilterInfo\achName, 1, @*pFilterUnk, caGUID\cElems, caGUID\pElems, 0, 0, #Null) : Debug "7"
				If g_MediaFullscreen
					*object\pWindow\SetWindowForeground(#OATRUE)
				EndIf
				*pFilterUnk\Release()
				FilterInfo\pGraph\Release()
				CoTaskMemFree_(caGUID\pElems)
				ProcedureReturn #True
			EndIf
		EndIf
	EndProcedure

	; Public Procedures

	Procedure.i Resize(Object.i, x.i = #PB_Default, y.i = #PB_Default, width.i = #PB_Default, height.i = #PB_Default, keepAR.i = #True)
		_GetMediaObject(*object)
		If x > #PB_Default
			*object\pWindow\put_Left(x)
		EndIf
		If y > #PB_Default
			*object\pWindow\put_Top(y)
		EndIf
		If width > #PB_Default
			*object\pVideo\put_DestinationWidth(width)
			*object\pWindow\put_width(width)
			*object\width = width
		EndIf
		If height > #PB_Default
			If keepAR
				*object\pVideo\put_DestinationHeight(width/*object\aspectRatio)
				*object\pVideo\put_Destinationtop((height/2)-(width/*object\aspectRatio)/2)
			Else
				*object\pVideo\put_DestinationHeight(height)
				*object\pVideo\put_Destinationtop(0)
			EndIf
			*object\pWindow\put_Height(height)
			*object\height = height
		EndIf
	EndProcedure
	
	Procedure.i Load(Object.i, filename.s, Parent=0, flags.i = #VMR7_Windowed)
		_GetMediaObject(*object)
		Protected pVmr.IBaseFilter, pVidRend.IBaseFilter, pAudR.IBaseFilter, pFilter.IBaseFilter
		Protected pEnum.IEnumFilters, pVMRCnfg.IVMRFilterConfig, pWc.IVMRWindowlessControl, PAR.IVMRAspectRatioControl
		Protected VMR.b, pIndividualRenderer, RendName.s, pFltrCnfg, pWndCntrl, pARControl, vw, vh, ax, ay, cFetched, ar.f
		Protected FilterInfo.FILTER_INFO
		
		_BuildInterfaces(Object)
		*object\renderer = 0
		
		If flags & #VMR9_Windowed Or flags & #VMR9_Windowless Or flags & #VMR7_Windowed Or flags & #VMR7_Windowless Or flags & #OldVideoRenderer Or flags & #OverlayMixer ;VidRenderer
			If flags & #VMR9_Windowed Or flags & #VMR9_Windowless
				*object\renderer | #VMR9_Windowed
				pIndividualRenderer = @CLSID_VideoMixingRenderer9 : RendName = "Video Mixing Renderer 9"
			ElseIf flags & #VMR7_Windowed Or flags & #VMR7_Windowless
				*object\renderer | #VMR7_Windowed
				pIndividualRenderer = @CLSID_VideoMixingRenderer  : RendName = "Video Mixing Renderer 7"
			ElseIf flags & #OverlayMixer
				*object\renderer | #OverlayMixer
				pIndividualRenderer = @CLSID_OverlayMixer         : RendName = "Overlay Mixer"
			ElseIf flags & #OldVideoRenderer
				*object\renderer | #OldVideoRenderer
				pIndividualRenderer = @CLSID_VideoRenderer        : RendName = "Old Video Renderer"
			EndIf
			
			If CoCreateInstance_(pIndividualRenderer, #Null, #CLSCTX_INPROC, @IID_IBaseFilter, @pVidRend) = #S_OK
				If *object\pGraphBuilder\AddFilter(pVidRend, RendName) = #S_OK
					VMR = #False
					If flags & #VMR9_Windowed Or flags & #VMR9_Windowless
						pFltrCnfg = @IID_IVMRFilterConfig9
						pWndCntrl = @IID_IVMRWindowlessControl9
						pARControl= @IID_IVMRAspectRatioControl9
						VMR = #True
					ElseIf flags & #VMR7_Windowed Or flags & #VMR7_Windowless
						pFltrCnfg = @IID_IVMRFilterConfig
						pWndCntrl = @IID_IVMRWindowlessControl
						pARControl= @IID_IVMRAspectRatioControl
						VMR = #True
					EndIf
					If VMR
						If pVidRend\QueryInterface(pFltrCnfg, @pVMRCnfg) = #S_OK
							If flags & #VMR9_Windowed Or flags & #VMR7_Windowed
								CHECK_(pVMRCnfg\SetRenderingMode(#VMRMode_Windowed))
								If flags & #VMR7_ForceOverlays
									CHECK_(pVMRCnfg\SetRenderingPrefs(#RenderPrefs_ForceOverlays))
								ElseIf flags & #VMR7_ForceOffscreen
									CHECK_(pVMRCnfg\SetRenderingPrefs(#RenderPrefs_ForceOffscreen))
								EndIf
								If flags & #DontKeepAR
									If pVidRend\QueryInterface(pARControl, @PAR) = #S_OK
										CHECK_(PAR\SetAspectRatioMode(0))
										PAR\Release()
									EndIf
								EndIf
							ElseIf flags & #VMR9_Windowless Or flags & #VMR7_Windowless
								CHECK_(pVMRCnfg\SetRenderingMode(#VMRMode_Windowless))
								If pVidRend\QueryInterface(@pWndCntrl, @pWc) = #S_OK And Parent
									CHECK_(pWc\SetVideoClippingWindow(Parent))
									CHECK_(pWc\SetAspectRatioMode(0))
									pWc\Release()
								EndIf
							EndIf
							pVMRCnfg\Release()
						Else
							Debug "Error: Getting Interface for VMR Config failed"
						EndIf
					EndIf
				Else
					Debug "Error: Adding Individual video render filter failed" 
				EndIf
				pVidRend\Release()
			Else
				Debug "Error: Couldn't Create Instance of individual video renderer"
			EndIf
		EndIf
		
		RendName = ""
		If flags & #WaveOutRenderer
			RendName = "AudioWaveOut Renderer"
			pIndividualRenderer = @CLSID_AudioRender
		ElseIf flags & #DirectSoundRenderer
			RendName = "DirectSound Renderer"
			pIndividualRenderer = @CLSID_DSoundRender
		EndIf
		If RendName
			If CoCreateInstance_(pIndividualRenderer, #Null, #CLSCTX_INPROC, @IID_IBaseFilter, @pAudR) = #S_OK
				If *object\pGraphBuilder\AddFilter(pAudR, RendName) = #S_OK
					pAudR\Release()
				Else
					Debug "Error: Adding Individual audio render filter failed"
				EndIf
			Else
				Debug "Error: Couldn't Create Instance of individual audio renderer"
			EndIf
		EndIf
		If *object\pGraphBuilder\RenderFile(filename, #Null) = #S_OK
			
			If Parent
				*object\hwnd = Parent
				*object\pVideo\get_SourceWidth(@vw)
				*object\pVideo\get_SourceHeight(@vh)
				*object\pVideo\GetPreferredAspectRatio(@ax, @ay)
				
				If ax And ay
					*object\aspectRatio = ax/ay
					*object\widthPAR = (vh * *object\aspectRatio); * 0.70
					vw = *object\widthPAR
					Debug "aspektRatio  : "+StrF(*object\aspectRatio,3)
					Debug "WidthPAR  : "+Str(vw)
				EndIf
				
				*object\width = vw
				*object\height = vh
				Resize(Object, 0, 0, vw, vh)
				CHECK_(*object\pWindow\put_Owner(*object\hwnd))
				CHECK_(*object\pWindow\put_WindowStyle(#WS_CHILD|#WS_CLIPSIBLINGS|#WS_CLIPCHILDREN))
				CHECK_(*object\pWindow\put_Visible(#OATRUE))
			EndIf
			
			If *object\pEvent\SetNotifyWindow(Parent, #WM_GRAPHEVENT, Object.i) = #S_OK
				If *object\pEvent\SetNotifyFlags(0) <> #S_OK
				EndIf
			Else
				Debug "Info: Media notification callback has not been applied"
			EndIf
			If *object\pGraphBuilder\EnumFilters(@pEnum) = #S_OK
				Debug " "
				Debug "--------- Filtergraph ---------"
				While pEnum\Next(1, @pFilter, @cFetched) = #S_OK
					pFilter\QueryFilterInfo(@FilterInfo)
					AddElement(filters())
						Debug PeekS(@FilterInfo\achName, #MAX_FILTER_NAME, #PB_Unicode)
						filters() = PeekS(@FilterInfo\achName, #MAX_FILTER_NAME, #PB_Unicode)
						If FilterInfo\pGraph <> #Null
							FilterInfo\pGraph\Release()
						EndIf
						pFilter\Release()
					Wend
					Debug "--------------------------------------"
					Debug " "
				Else
					Debug "Error: Could not enumerate filters"
				EndIf
				*object\pSeeking\SetTimeFormat(@TIME_FORMAT_MEDIA_TIME)
				*object\pGraphBuilder\Release()
				
				ProcedureReturn #True
			Else
				Debug "Error: Rendering file failed"
				ProcedureReturn #False
			EndIf
			
		EndProcedure
		
	Procedure.i Play(Object.i)
		_GetMediaObject(*object)
		ProcedureReturn *object\pControl\run()
	EndProcedure
	
	Procedure.i Pause(Object.i)
		_GetMediaObject(*object)
		ProcedureReturn *object\pControl\pause()
	EndProcedure
	
	Procedure.i Seek(Object.i, pos.q, SeekByFrame.i=#False)
		Protected Ret.i
		_GetMediaObject(*object)
		Protected duration.q
		*object\pSeeking\GetDuration(@duration)
		If SeekByFrame = #False
			pos * 10000
		Else
			*object\pSeeking\SetTimeFormat(@TIME_FORMAT_FRAME)
		EndIf
		
		Ret = *object\pSeeking\SetPositions(@pos, #AM_SEEKING_AbsolutePositioning,@duration, #AM_SEEKING_NoPositioning)
		
		*object\pSeeking\SetTimeFormat(@TIME_FORMAT_MEDIA_TIME)
		
		ProcedureReturn Ret
	EndProcedure
	
	Procedure.i Stop(Object.i)
		_GetMediaObject(*object)
		ProcedureReturn *object\pControl\stop()
	EndProcedure
	
	Procedure.i Lenght(Object.i, mode.i = #MEDIA_TIME_MSECS)
		_GetMediaObject(*object)
		Protected duration.q, avgTimePerFrame.d
		*object\pSeeking\GetDuration(@duration)
		If mode = #MEDIA_TIME_MSECS
			ProcedureReturn duration/10000 ; result in ms
		ElseIf mode = #MEDIA_TIME_FRAMES
			*object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
			If avgTimePerFrame > 0
				ProcedureReturn (duration/10000) / (avgTimePerFrame*1000) ; result in frames
			EndIf
		EndIf
	EndProcedure
	
	Procedure.i Width(Object.i)
		_GetMediaObject(*object)
		ProcedureReturn *object\width
	EndProcedure
	
	Procedure.i Height(Object.i)
		_GetMediaObject(*object)
		ProcedureReturn *object\height
	EndProcedure
	
	Procedure.i ToggleFullscreen(Object.i)
		_GetMediaObject(*object)
		Protected res.i
		Global  g_origWidth.i, g_OrigHeigth.i
		If Not *object\renderer & #OverlayMixer
			If *object\fullscreen = #True
				SetWindowPos_(FindWindow_("Shell_traywnd", ""), 0, 0, 0, 0, 0, #SWP_SHOWWINDOW)
				Resize(Object.i, #PB_Default, #PB_Default, g_origWidth, g_OrigHeigth)
				*object\pWindow\put_Owner(*object\hwnd)
				*object\pWindow\SetWindowForeground(#OAFALSE)
				*object\pWindow\HideCursor(#OAFALSE)
				UpdateWindow_(*object\hwnd)
				SetForegroundWindow_(*object\hwnd)
				SetFocus_(*object\hwnd)
				*object\fullscreen = #False
				g_MediaFullscreen = #False
				ShowWindow_(*object\hwnd, #SW_SHOW)
				KillThread(*object\thread)
			Else
				ExamineDesktops()
				g_origWidth = Width(Object)
				g_OrigHeigth = Height(Object)
				*object\pWindow\put_Owner(GetDesktopWindow_())
				ShowWindow_(*object\hwnd, #SW_HIDE)
				*object\pWindow\SetWindowForeground(#OATRUE)
				SetWindowPos_(FindWindow_("Shell_traywnd", ""), GetDesktopWindow_(), 0, 0, 0, 0, #SWP_HIDEWINDOW)
				Resize(Object, #PB_Default, #PB_Default, DesktopWidth(0), DesktopHeight(0))
				*object\fullscreen = #True
				g_MediaFullscreen = #True
				*object\thread = CreateThread(@ToggleCursorFullscreen(), *object)
			EndIf
			
			ProcedureReturn #True
		EndIf
	EndProcedure
	
	Procedure.i Position(Object.i, mode.i = #MEDIA_TIME_MSECS)
		_GetMediaObject(*object)
		Protected pos.q, avgTimePerFrame.d
		*object\pSeeking\GetCurrentPosition(@pos)
		If mode = #MEDIA_TIME_MSECS
			ProcedureReturn pos/10000 ; result in ms
		ElseIf mode = #MEDIA_TIME_FRAMES
			*object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
			If avgTimePerFrame > 0
				ProcedureReturn (pos/10000) / (avgTimePerFrame*1000)
			EndIf
		EndIf
	EndProcedure
	
	Procedure.i State(Object.i)
		_GetMediaObject(*object)
		Protected pfs.i
		*object\pControl\GetState(10,@pfs)
		ProcedureReturn pfs
	EndProcedure
	
	Procedure.f FPS(Object.i) ; return .f cause we just need float precision
		_GetMediaObject(*object)
		Protected avgTimePerFrame.d
		*object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
		If avgTimePerFrame > 0
			ProcedureReturn 1/avgTimePerFrame
		Else
			ProcedureReturn #False
		EndIf
	EndProcedure
	
	Procedure.i CaptureCurrMediaImage(Object.i, ResultingImgNo.i)
		_GetMediaObject(*object)
		Protected DataSize.i, *pImg.BITMAPINFOHEADER
		If IsImage(ResultingImgNo) = 0
			If *object\pVideo\GetCurrentImage(@DataSize, #Null) = #S_OK
				*pImg = AllocateMemory(DataSize)
				If *pImg
					If *object\pVideo\GetCurrentImage(@DataSize, *pImg) = #S_OK
						If CreateImage(ResultingImgNo, *pImg\biWidth, *pImg\biHeight, *pImg\biBitCount)
							If SetDIBits_(0, ImageID(ResultingImgNo), 0, *pImg\biHeight, *pImg+*pImg\biSize, *pImg, #DIB_RGB_COLORS)
								ProcedureReturn #True
							EndIf
						EndIf
					Else
						Debug "Info: Capturing current image not possible"
					EndIf
					FreeMemory(*pImg)
				Else
					Debug "Error: Allocating ImgBuffer memory failed"
				EndIf
			Else
				Debug "Error: Couldn't measure needed imagebuffer - or actual media contains no videostream"
			EndIf
		Else
			Debug "Error: ImageNumer already valid"
		EndIf
	EndProcedure
	
	Procedure.i OnMediaEvent(Object.i)
		_GetMediaObject(*object)
		Protected EventCode.i, Param1.i, Param2.i
		While *object\pEvent\GetEvent(@EventCode, @Param1, @Param2, 0) <> #E_ABORT
			Select EventCode
				Case #EC_COMPLETE
					*object\pControl\stop() ; If an #EC_COMPLETE notify occurs we do change the media state to stopped
					Debug "... end has been reached."
			EndSelect
			*object\pEvent\FreeEventParams(EventCode, Param1, Param2)
		Wend
	EndProcedure
	
	Procedure.s Time2String(time.i)
		Protected ti.s, SS, MM, HH, ms
		ms = time%1000
		SS = Int(time / 1000) : While SS > 59:SS-60:Wend
		MM = Int(time / 1000 / 60) : While MM > 59:MM-60:Wend
		HH = Int(time / 1000 / 60 / 60) : While HH > 59:HH-60:Wend
		ti.s =RSet(StrU(HH,#PB_Byte),2,"0")+":"+RSet(StrU(MM,#PB_Byte),2,"0")+":"+RSet(StrU(SS,#PB_Byte),2,"0")+":"+RSet(StrU(ms,#PB_Byte),3,"0")
		ProcedureReturn ti.s
	EndProcedure
	
	Procedure.i GetVolume(Object.i) ; from -100db to 0db
		_GetMediaObject(*object)
		Protected db.i
		*object\pAudio\get_Volume(@db)
		ProcedureReturn db/100
	EndProcedure
	
	Procedure.i PutVolume(Object.i, db.i) ; from -100db to 0db
		_GetMediaObject(*object)
		If db > -85 And db < 1 ; dont change -85 to -101 as it will mess up WaveOut. A bug in the API ?
			Delay(10) : *object\pAudio\put_Volume(db*100)
		EndIf
	EndProcedure
	
	Procedure.i PutBalance(Object.i, bal.i) ; -100 to +100
		_GetMediaObject(*object)
		*object\pAudio\put_balance(bal*100)
	EndProcedure
	
	Procedure.i GetBalance(Object.i) ; from -100 to +100
		_GetMediaObject(*object)
		Protected bal
		*object\pAudio\get_balance(@bal)
		ProcedureReturn Int(bal/100)
	EndProcedure
	
	Procedure.i Close(Object.i)
		_GetMediaObject(*object)
		
		Protected pfs.i
		If g_MediaFullscreen
			ToggleFullscreen(Object)
		EndIf
		*object\pControl\GetState(10,@pfs)
		If Not pfs = #State_Stopped
			*object\pControl\stop()
		EndIf
		*object\pWindow\put_Visible(#OAFALSE)
		*object\pWindow\put_Owner(#OAFALSE)
		*object\pEvent\SetNotifyWindow(#Null, 0, 0)
		_DeleteInterfaces(Object)
		ClearList(filters())
		ProcedureReturn #True
	EndProcedure
			
	Procedure.i IsMedia(Object.i)
		If g_DshowObjects
			If Object<>#PB_Any And Object_IsObject(g_DshowObjects, Object)
				ProcedureReturn #True
			EndIf
		EndIf
	EndProcedure
	
	; Special Procedures
	
	Procedure.i CreateInstance()
		Protected *This = AllocateMemory(SizeOf(Integer))
		Protected *object.Dshow_Interfaces
		If Not g_DshowObjects
			g_DshowObjects = Object_Init(SizeOf(Dshow_Interfaces), 1, @FreeInstance())
		EndIf
		*object = Object_GetOrAllocateID(g_DshowObjects, *This)
		If *object
			*object\Object = #True
			CoInitializeEx_(0, $02); #COINIT_APARTMENTTHREADED
														 ;CoInitialize_(0)
			ProcedureReturn *This
		Else
			Debug "Fatal Error: The given media no. hasn't been initialized!"
			CallDebugger
			ProcedureReturn #False
		EndIf
	EndProcedure
	
	Procedure.i FreeInstance(Object.i)
		If Object<>#PB_Any And Object_IsObject(g_DshowObjects, Object)
			_GetMediaObject(*object)
			Protected pfs.i
			If *object\pControl
				*object\pControl\GetState(10,@pfs)
				If Not pfs = #State_Stopped
					*object\pControl\stop()
				EndIf
				Close(Object)
			EndIf
			CoUninitialize_()
			Object_FreeID(g_DshowObjects, Object)
			*object\Object = #False
			FreeMemory(Object)
		EndIf
	EndProcedure

EndModule
Example:

Code: Select all

IncludeFile "DshowMedia.pb"

Define *Media
Define MainWindow.i
Define File.s = OpenFileRequester("Open Media File", "", "*.*", 0)

MainWindow = OpenWindow(#PB_Any,20,20,500,500,"PB native Dshow example", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)   

If File
	*Media = DshowMedia::CreateInstance()
  If DshowMedia::Load(*Media, File, WindowID(MainWindow))
    ResizeWindow(MainWindow, #PB_Ignore, #PB_Ignore, DshowMedia::Width(*Media), DshowMedia::Height(*Media))
    DshowMedia::Play(*Media)
    Debug DshowMedia::FPS(*Media)
  EndIf
Else
	End
EndIf

 
Repeat
 DshowMedia::OnMediaEvent(*Media)
Until DshowMedia::State(*Media) = DshowMedia::#State_Stopped Or WaitWindowEvent(10) = #PB_Event_CloseWindow

DshowMedia::PutVolume(*Media,0) ; '0' means 0db = maxVolume --> this is necessary! Otherwise the system sound device will keep the vol state even when appl. has been closed.
Debug DshowMedia::FreeInstance(*Media)
Post Reply