Date: 02-16-2022
Return to Index
created by gbSnippets
'https://docs.microsoft.com/en-us/windows/desktop/directshow/video-capabilities IAMStreamConfig
'https://docs.microsoft.com/en-us/windows/desktop/DirectShow/about-media-types
'https://docs.microsoft.com/en-us/windows/desktop/directshow/using-the-sample-grabber
'https://docs.microsoft.com/en-us/windows/desktop/DirectShow/configure-the-video-output-format
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
#Debug Error On
#Debug Display On
%Unicode = 1
#Include "Win32API.inc"
#Include Once "dshow.inc"
#Include "qedit.inc"
Global hDlg, hr, w, h 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 pceltFetched As Dword
Global pCap As IBaseFilter 'Video capture filter
Global pControl As IMediaControl
Global pWindow As IVideoWindow 'Display Window
Global pConfig As IAMStreamConfig 'video output format
Function PBMain() As Long
Dialog New Pixels, 0, "First Camera Test",300,300,400,300, %WS_OverlappedWindow Or %WS_ClipChildren To hDlg
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local w,h As Long
Select Case Cb.Msg
Case %WM_InitDialog : DisplayFirstCamera
Case %WM_Size
If IsObject(pWindow) Then
Dialog Get Client hDlg To w,h
pWindow.SetWindowPosition(0,0,w,h)
Else
Dialog Set Text hDlg, "No Cameras"
End If
Case %WM_Help
GetCurrentFormat(w,h)
? Str$(w) + Str$(h)
End Select
End Function
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.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
pControl = pGraph
pControl.Run
End Sub
'Type VIDEOINFOHEADER Qword Fill
' rcSource As RECT ' RECT // The bit we really want to use
' rcTarget As RECT ' RECT // Where the video should go
' dwBitRate As Dword ' DWORD // Approximate bit data rate
' dwBitErrorRate As Dword ' DWORD // Bit error rate for this stream
' AvgTimePerFrame As Quad ' REFERENCE_TIME // Average time per frame (100ns units)
' bmiHeader As BITMAPINFOHEADER ' BITMAPINFOHEADER
'End Type
'Type VIDEO_STREAM_CONFIG_CAPS ' Must be 8 byte aligned
' guid As Guid ' GUID guid
' VideoStandard As Dword ' ULONG VideoStandard
' InputSize As Size ' SIZE InputSize
' MinCroppingSize As Size ' SIZE MinCroppingSize
' MaxCroppingSize As Size ' SIZE MaxCroppingSize
' CropGranularityX As Long ' int CropGranularityX
' CropGranularityY As Long ' int CropGranularityY
' CropAlignX As Long ' int CropAlignX
' CropAlignY As Long ' int CropAlignY
' MinOutputSize As Size ' SIZE MinOutputSize
' MaxOutputSize As Size ' SIZE MaxOutputSize
' OutputGranularityX As Long ' int OutputGranularityX
' OutputGranularityY As Long ' int OutputGranularityY
' StretchTapsX As Long ' int StretchTapsX
' StretchTapsY As Long ' int StretchTapsY
' ShrinkTapsX As Long ' int ShrinkTapsX
' ShrinkTapsY As Long ' int ShrinkTapsY
' alignment__ As Dword
' MinFrameInterval As Quad ' LONGLONG MinFrameInterval
' MaxFrameInterval As Quad ' LONGLONG MaxFrameInterval
' MinBitsPerSecond As Long ' LONG MinBitsPerSecond
' MaxBitsPerSecond As Long ' LONG MaxBitsPerSecond
'
' HRESULT GetStreamCaps(
' int iIndex,
' AM_MEDIA_TYPE **pmt,
' BYTE *pSCC
'
'Type AM_MEDIA_TYPE Dword
' majortype As Guid ' GUID majortype
' subtype As Guid ' GUID subtype
' bFixedSizeSamples As Long ' BOOL bFixedSizeSamples
' bTemporalCompression As Long ' BOOL bTemporalCompression
' lSampleSize As Dword ' ULONG lSampleSize
' formattype As Guid ' GUID formattype
' pUnk As Dword Ptr ' IUnknown *pUnk
' cbFormat As Dword ' ULONG cbFormat
' pbFormat As Byte Ptr ' [size_is(cbFormat)] BYTE *pbFormat
'End Type
'Type VIDEOINFOHEADER Qword Fill
' rcSource As RECT ' RECT // The bit we really want to use
' rcTarget As RECT ' RECT // Where the video should go
' dwBitRate As Dword ' DWORD // Approximate bit data rate
' dwBitErrorRate As Dword ' DWORD // Bit error rate for this stream
' AvgTimePerFrame As Quad ' REFERENCE_TIME // Average time per frame (100ns units)
' bmiHeader As BITMAPINFOHEADER ' BITMAPINFOHEADER
'End Type
'Type BITMAPINFOHEADER Dword Fill
' biSize As Dword
' biWidth As Long
' biHeight As Long
' biPlanes As Word
' biBitCount As Word
' biCompression As Dword
' biSizeImage As Dword
' biXPelsPerMeter As Long
' biYPelsPerMeter As Long
' biClrUsed As Dword
' biClrImportant As Dword
'End Type
'pmt.MajorType = $MediaType_Video
'pmt.SubType = $GUID_Null
'pmt.FormatType = $GUID_Null
Sub GetSupportedFormats
'Global pCap As IBaseFilter 'Video capture filter
'Global pConfig As IAMStreamConfig 'video output format
Local i,pCount, pSize,wTarget,hTarget,wRes,hRes As Long
Local pmt As AM_Media_Type
Local pSCC As Video_Stream_Config_Caps
wTarget = 1920
hTarget = 1080
pBuild.FindInterface(ByVal %Null, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig) 'get pConfig - IAMStreamConfig interface
'MSDN says pCap OR pConfig can be used to cpature a device's output format
If 0 Then
hr = pConfig.GetFormat(pmt)
Else
pConfig.GetNumberOfCapabilities(pCount, pSize) 'get pCount, pSize pCount is number of media types
For i = 0 To pCount-1 'iterate through number of capabilities
pConfig.GetStreamCaps(i, pmt, VarPtr(pSCC)) 'get pmt and pSCC
'can change pmt. pSCC describes valid ways to change pmt
wRes = pSCC.InputSize.cx
hRes = pSCC.InputSize.cy
If wRes = wTarget And hRes = hTarget Then
? "Bingo"
pConfig.SetFormat(pmt) : Exit For 'configure device to use pmt
End If
Next i
'pConfig.SetFormat(pmt)
End If
End Sub
Sub GetCurrentFormat(wRes As Long, hRes As Long)
'https://www.e-consystems.com/blog/camera/resolution-switching-in-directshow-camera-application/
'http://www.voidcn.com/article/p-omltkzvq-xu.html set resolution with direct show
'https://technet.microsoft.com/zh-tw/dd373477(v=vs.71) AM_Media_Type
'Global pCap As IBaseFilter 'Video capture filter
'Global pConfig As IAMStreamConfig 'video output format
Local pmt As AM_Media_Type
Local pSCC As Video_Stream_Config_Caps
Local pVIH As VideoInfoHeader Ptr
pBuild.FindInterface(ByVal %Null, $MediaType_Video, pCap, $IID_IAMStreamConfig, pConfig) 'get pConfig - IAMStreamConfig interface
If IsObject(pConfig) Then ? "Success" Else ? "Fail"
If IsNothing(pConfig) Then ? "Fail" Else ? "Success"
If hr = %S_Ok Then ? "Success" Else ? "Fail"
hr = pConfig.GetFormat(pmt)
If hr = %S_Ok Then ? "Success" Else ? "Fail"
If pmt.cbFormat = 0 Then ? "Fail" Else ? "Success"
If pmt.FormatType = $Format_None Then ? "none"
If pmt.FormatType = $Format_VideoInfo Then ? "VideoInfo"
If pmt.FormatType = $Format_VideoInfo2 Then ? "VideoInfo2"
If pmt.FormatType = $GUID_NULL Then ? "GUID_Null"
If pmt.FormatType = $Format_DvInfo Then ? "DvInfo"
If pmt.FormatType = $Format_MPEGVideo Then ? "MPEGVideo"
pVIH = pmt.pbFormat
wRes = @pVIH.bmiHeader.biWidth
hRes = @pVIH.bmiHeader.biHeight
End Sub
http://www.garybeene.com/sw/gbsnippets.htm