Date: 02-16-2022
Return to Index
created by gbSnippets
Type CameraFormats
w As Long
h As Long
bits As Long
End Type
Global hDlg, hContext As Dword
Global pGraph As IGraphBuilder 'Filter Graph Manager
Global pBuild As ICaptureGraphBuilder2 'Capture Graph Builder
Global pSysDevEnum As ICreateDevEnum 'enumeration object
Global pEnumCat As IEnumMoniker
Global pMoniker As IMoniker 'contains information about other objects
Global pbc As IBindCTX
Global pceltFetched As Dword
Global pCap As IBaseFilter 'Video capture filter
Global pPropBag As IPropertyBag
Global pControl As IMediaControl
Global pWindow As IVideoWindow 'Display Window
Global pConfig As IAMStreamConfig 'video output format
Global gPMT As AM_Media_Type
Global SF() As CameraFormats 'supported formats
Global Camera$, CameraList$
Global TargetFormat, CameraCount, CameraIndex, FormatIndex As Long
Sub GetCameraList 'stops enumeration on moniker which has the friendly name
Local pwszDisplayName As WStringZ Ptr, varName As Variant
Reset CameraCount, CameraList$
pSysDevEnum = NewCom ClsId $CLSID_SystemDeviceEnum 'enumeration object
If pSysDevEnum.CreateClassEnumerator($CLSID_VideoInputDeviceCategory, pEnumCat, 0) = %S_False Then Exit Sub
While pEnumCat.next(1, pMoniker, pceltFetched) <> %S_False
Incr CameraCount
pMoniker.GetDisplayName(pbc, Nothing, pwszDisplayName) 'get complex camera name
pMoniker.BindToStorage(Nothing, Nothing, $IID_IPropertyBag, pPropBag) 'get info about Moniker
pPropBag.Read("FriendlyName", varName, Nothing) 'get friendly name
CameraList$ += Variant$$(varName) + $CrLf
Wend
CameraList$ = Trim$(CameraList$,Any $CrLf)
End Sub
Sub DisplayFirstCamera
pGraph = NewCom ClsId $CLSID_FilterGraph 'filter graph
pBuild = NewCom ClsId $CLSID_CaptureGraphBuilder2 'capture graph builder
pSysDevEnum = NewCom ClsId $CLSID_SystemDeviceEnum 'enumeration object
If pSysDevEnum.CreateClassEnumerator($CLSID_VideoInputDeviceCategory, pEnumCat, 0) <> %S_Ok Then Exit Sub
pEnumCat.next(1, pMoniker, pceltFetched) 'cycle through monikders
pMoniker.BindToObject(Nothing, Nothing, $IID_IBaseFilter, pCap) 'create device filter for the chosen device
pGraph.AddFilter(pCap,"First Camera") 'add chosen device filter to the filter graph
pBuild.FindInterface(ByVal %Null, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig)
pConfig.SetFormat(gPMT)
pBuild.SetFilterGraph(pGraph) 'initialize pBuild
pBuild.RenderStream $Pin_Category_Preview, $MediaType_Video, pCap, Nothing, Nothing 'render the live source
pWindow = pGraph : pWindow.Owner = hDlg : pWindow.WindowStyle = %WS_Child Or %WS_ClipChildren 'video window settings
pWindow.SetWindowPosition(0,0,640,480)
pControl = pGraph
pControl.Run
End Sub
Sub DisplayNamedCamera
pGraph = NewCom ClsId $CLSID_FilterGraph 'filter graph
pBuild = NewCom ClsId $CLSID_CaptureGraphBuilder2 'capture graph builder
pMoniker.BindToObject(Nothing, Nothing, $IID_IBaseFilter, pCap) 'create device filter for the chosen device
pGraph.AddFilter(pCap,"First Camera") 'add chosen device filter to the filter graph
pBuild.FindInterface(ByVal %Null, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig)
pConfig.SetFormat(gPMT)
pBuild.SetFilterGraph(pGraph) 'initialize pBuild
pBuild.RenderStream $Pin_Category_Preview, $MediaType_Video, pCap, Nothing, Nothing 'render the live source
pWindow = pGraph : pWindow.Owner = hDlg : pWindow.WindowStyle = %WS_Child Or %WS_ClipChildren 'video window settings
pWindow.SetWindowPosition(0,0,1280,720)
pControl = pGraph
pControl.Run
End Sub
Sub GetMatchingMoniker 'stops enumeration on moniker which has the friendly name
Local pbc As IBindCTX
Local pceltFetched As Dword, pwszDisplayName As WStringZ Ptr, varName As Variant
pSysDevEnum = NewCom ClsId $CLSID_SystemDeviceEnum 'enumeration object
If pSysDevEnum.CreateClassEnumerator($CLSID_VideoInputDeviceCategory, pEnumCat, 0) <> %S_Ok Then Exit Sub
While pEnumCat.next(1, pMoniker, pceltFetched) <> %S_False 'cycle through monikers
pMoniker.GetDisplayName(pbc, Nothing, pwszDisplayName) 'get complex camera name
pMoniker.BindToStorage(Nothing, Nothing, $IID_IPropertyBag, pPropBag) 'get info about Moniker
pPropBag.Read("FriendlyName", varName, Nothing) 'get friendly name
If Variant$$(varName) = Camera$ Then Exit Do
Loop
End Sub
Sub GetCurrentFormat(wRes As Long, hRes As Long, fBits As Long)
Local pmt As AM_Media_Type Ptr
Local pVIH As VideoInfoHeader Ptr
pBuild.FindInterface(ByVal %Null, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig) 'get pConfig - IAMStreamConfig interface
pConfig.GetFormat(ByVal VarPtr(pmt)) 'get pmt (interface of currently displayed camera
pVIH = @pmt.pbFormat 'get the VideoInfoHeader
'get the width and height
wRes = @pVIH.bmiHeader.biWidth
hRes = @pVIH.bmiHeader.biHeight
fBits = @pVIH.bmiHeader.biBitCount
End Sub
Sub SetCurrentFormat()
Local pmt As AM_MEDIA_TYPE Pointer
Local pVSCC As VIDEO_STREAM_CONFIG_CAPS 'only needed so can use GetStreamCaps. Otherwise not used.
pBuild.FindInterface(ByVal %NULL, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig) 'get pConfig
pConfig.GetStreamCaps(CameraIndex, ByVal VarPtr(pmt), ByVal VarPtr(pVSCC)) 'get PMT
gPMT = @pmt 'set global PMT
End Sub
Sub GetSupportedFormats
Local i,pCount, pSize As Long
Local pmt As AM_Media_Type Ptr
Local pVIH As VideoInfoHeader Ptr
Local pSCC As Video_Stream_Config_Caps
pBuild.FindInterface(ByVal %Null, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig) 'get pConfig - IAMStreamConfig interface
pConfig.GetNumberOfCapabilities(pCount, pSize) 'get pCount, pSize pCount is number of media types
ReDim SF(pCount-1)
For i = 0 To pCount-1 'iterate through number of capabilities
pConfig.GetStreamCaps(i, ByVal VarPtr(pmt), ByVal VarPtr(pSCC)) 'get pmt and pSCC
pVIH = @pmt.pbFormat
If @pmt.cbFormat <> SizeOf(VideoInfoHeader) Then pVIH += 24
SF(i).w = @pVIH.bmiHeader.biWidth
SF(i).h = @pVIH.bmiHeader.biHeight
SF(i).bits = @pVIH.bmiHeader.biBitCount
Next i
End Sub
Function SetMatchingFormat(wRes As Long, hRes As Long, fBits As Long) As Long
Local i,pCount, pSize As Long
Local pmt As AM_Media_Type Ptr
Local pVIH As VideoInfoHeader Ptr
Local pVCC As Video_Stream_Config_Caps
pBuild.FindInterface(ByVal %Null, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig) 'get pConfig - IAMStreamConfig interface
pConfig.GetNumberOfCapabilities(pCount, pSize) 'get pCount, pSize pCount is number of media types
For i = 0 To pCount-1 'iterate through available capabilities
pConfig.GetStreamCaps(i, ByVal VarPtr(pmt), ByVal VarPtr(pVCC)) 'get pmt and pSCC
pVIH = @pmt.pbFormat
If @pmt.cbFormat <> SizeOf(VideoInfoHeader) Then pVIH += 24 'check for Header2
If wRes = @pVIH.bmiHeader.biWidth And hRes = @pVIH.bmiHeader.biHeight And fBits = @pVIH.bmiHeader.biBitCount Then
pBuild.FindInterface(ByVal %NULL, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig) 'get pConfig
pConfig.GetStreamCaps(i, ByVal VarPtr(pmt), ByVal VarPtr(pVCC)) 'get PMT
gPMT = @pmt 'set global PMT
DisplayNamedCamera
GetCurrentFormat(wRes,hRes,fBits)
SetDialogCaption(wRes,hRes,fBits)
Function = 1 : Exit Function
End If
Next i
End Function
Sub SetDialogCaption(w As Long, h As Long, fBits As Long)
Dialog Set Text hDlg, "DirectShow Example: " + Camera$ + " " + Trim$(Str$(w)) + " x" + Trim$(Str$(h)) + " " + Str$(fBits)
End Sub
http://www.garybeene.com/sw/gbsnippets.htm