Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
%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
Global pGrabber As ISampleGrabber
Global pSample As IMediaSample
Global pEvents As IMediaEventEX
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
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
ConfigureFormat
' GetResolution 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
Sub GetResolution_Grabber(wRes As Long, hRes As Long)
Local pmt As AM_Media_Type
Local pVIH As VideoInfoHeader
pGrabber = NewCom ClsId $CLSID_SampleGrabber
pGraph.AddFilter(pGrabber,"Sample Grabber")
pmt.MajorType = $MediaType_Video
pmt.SubType = $GUID_Null
pmt.FormatType = $GUID_Null
pGrabber.SetMediaType(pmt)
' pGrabber.GetConnectedMediatType(pmt)
' pVIH = pmt.pbFormat
' wRes = pVIH.bmiHeader.biWidth
' hRes = pVIH.bmiHeader.biHeigth
' pGrabber.SetBufferSamples %True 'activates buffering
' pGrabber.SetOnoShot %True 'halt Grabber after first sample
' pGrabber.GetCurrentBuffer pBufferSize, %Null 'call twice. 1st to get needed buffer size. not use during run time
' 'allocate space
' pGrabber.GetCurrentBuffer pBufferSize, pBuffer 'call twice. 2nd to retrieve image
End Sub
http://www.garybeene.com/sw/gbsnippets.htm