Date: 02-16-2022
Return to Index
created by gbSnippets
Jose - Enumerate Filters
'Author Jose
' ========================================================================================
' The Filter Graph Manager supports the IFilterGraph.EnumFilters method, which enumerates
' all the filters in the filter graph. It returns a pointer to the IEnumFilters interface.
' The IEnumFilters.Next method retrieves IBaseFilter interface pointers.
' ========================================================================================
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
#Include "win32api.inc"
#Include Once "dshow.inc"
#Include Once "ole2utils.inc" ' For IUnknown_Release
Global FilterList$
Function PBMain
Local pGraph As IGraphBuilder
Local wszFile As WStringZ * %Max_Path
pGraph = NewCom ClsId $CLSID_FilterGraph
wszFile = Exe.Path$ & "alarm.wav"
pGraph.RenderFile(wszFile)
EnumFilters(pGraph)
pGraph = Nothing
? FilterList$
End Function
Function EnumFilters (ByVal pGraph As IGraphBuilder) As Long
Local hr As Long ' HRESULT
Local pEnum As IEnumFilters ' IEnumFilters interface
Local pFilter As IBaseFilter ' IBaseFilter interface
Local cFetched As Dword ' Number of filters fetched
Local FilterInfo As FILTER_INFO ' FILTER_INFO structure
hr = pGraph.EnumFilters(pEnum)
If hr <> %S_Ok Then
Function = hr
Exit Function
End If
Do
hr = pEnum.Next(1, pFilter, cFetched)
If hr <> %S_Ok Or cFetched = 0 Then Exit Do
Reset FilterInfo
hr = pFilter.QueryFilterInfo(FilterInfo)
If hr <> %S_Ok Then
FilterList$ = "Could not get the filter info"
Else
FilterList$ += FilterInfo.achName + $CrLf
' The FILTER_INFO structure holds a pointer to the Filter Graph
' Manager, with a reference count that must be released.
If FilterInfo.pGraph <> %NULL Then IUnknown_Release FilterInfo.pGraph
End If
' Release the filter
pFilter = Nothing
Loop
' Release the collection
pEnum = Nothing
Function = %S_Ok
End Function
====================================================================
Jose - Play Video Clip - DDT
'Compilable Example: (Jose Includes) DDT Version of Jose's Code
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
#Include Once "dshow.inc"
#Include Once "ole2utils.inc" ' For IUnknown_Release
%IDC_Graphic = 500
%WM_GraphNotify = %WM_User+13
Global hDlg As Dword
Global bIsPlaying As Long
' Interface pointers
Global pIGraphBuilder As IGraphBuilder
Global pIMediaControl As IMediaControl
Global pIMediaEventEx As IMediaEventEx
Global pIVideoWindow As IVideoWindow
Function PBMain() As Long
Dialog New Pixels, 0, "Direct Show Tests",,,600,400, %WS_OverlappedWindow To hDlg
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local w,h As Long, rc As Rect
Select Case Cb.Msg
Case %WM_InitDialog
PlayMovieInWindow(hDlg, "bubbles.mov")
Case %WM_Size
GetClientRect hDlg, rc
If IsObject(pIVideoWindow) Then
pIVideoWindow.SetWindowPosition(rc.Left, rc.Top, rc.Right, rc.Bottom)
RedrawWindow hDlg, rc, 0, %RDW_INVALIDATE Or %RDW_UPDATENOW
End If
Case %WM_GraphNotify
Local lEventCode As Long
Local lParam1 As Long
Local lParam2 As Long
If IsObject(pIMediaEventEx) Then
Do
pIMediaEventEx.GetEvent(lEventCode, lParam1, lParam2, 0)
If ObjResult <> %S_Ok Then Exit Do
pIMediaEventEx.FreeEventParams(lEventCode, lParam1, lParam2)
If lEventCode = %EC_COMPLETE Then
If IsObject(pIVideoWindow) Then
pIVideoWindow.Visible = %OAFALSE
pIVideoWindow.Owner = %NULL
pIVideoWindow = Nothing
End If
pIMediaControl = Nothing
pIMediaEventEx = Nothing
pIGraphBuilder = Nothing
bIsPlaying = %FALSE
Exit Do
End If
Loop
End If
Case %WM_Destroy
If IsObject(pIMediaControl) Then
pIMediaControl.Stop
pIMediaControl = Nothing
End If
If IsObject(pIVideoWindow) Then
pIVideoWindow.Visible = %OAFALSE
pIVideoWindow.Owner = %NULL
pIVideoWindow = Nothing
End If
pIMediaEventEx = Nothing
pIGraphBuilder = Nothing
End Select
End Function
Sub PlayMovieInWindow (ByVal hwnd As Dword, ByRef wszFileName As WStringZ)
Local hr As Long
' If there is a clip loaded, stop it
If IsObject(pIMediaControl) Then
pIMediaControl.Stop
pIMediaControl = Nothing
pIVideoWindow = Nothing
pIMediaEventEx = Nothing
pIGraphBuilder = Nothing
End If
' Create an instance of the IGraphBuilder object
pIGraphBuilder = NewCom ClsId $CLSID_FilterGraph
If hr <> %S_Ok Or IsNothing(pIGraphBuilder) Then Exit Sub
' Retrieve interafce pointers
pIMediaControl = pIGraphBuilder
If IsNothing(pIMediaControl) Then Exit Sub
pIMediaEventEx = pIGraphBuilder
If IsNothing(pIMediaEventEx) Then Exit Sub
pIVideoWindow = pIGraphBuilder
If IsNothing(pIVideoWindow) Then Exit Sub
' Render the file
hr = pIGraphBuilder.RenderFile(wszFileName)
If hr <> %S_Ok Then Exit Sub
' Set the window owner and style
pIVideoWindow.Visible = %OAFALSE
pIVideoWindow.Owner = hwnd
pIVideoWindow.WindowStyle = %WS_Child Or %WS_ClipSiblings Or %WS_ClipChildren
' Have the graph signal event via window callbacks for performance
pIMediaEventEx.SetNotifyWindow(hwnd, %WM_GRAPHNOTIFY, 0)
' Set the window position
Local rc As RECT
GetClientRect hwnd, rc
pIVideoWindow.SetWindowPosition(rc.Left, rc.Top, rc.Right, rc.Bottom)
' Make the window visible
pIVideoWindow.Visible = %OATRUE
' Run the graph
pIMediaControl.Run
bIsPlaying = %TRUE
End Sub
===================================================================
Play a File #0
'Compilable Example: (Jose Includes) Play Video - Minimal Code
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
#Include Once "dshow.inc"
#Include Once "ole2utils.inc" ' For IUnknown_Release
%IDC_Graphic = 500
%WM_GraphNotify = %WM_User+13
Global hDlg As Dword
' Interface pointers
Global pIGraphBuilder As IGraphBuilder
Global pIMediaControl As IMediaControl
Global pIMediaEventEx As IMediaEventEx
Global pIVideoWindow As IVideoWindow
Function PBMain() As Long
Dialog New Pixels, 0, "Direct Show Tests",,,600,400, %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, rc As Rect
Select Case Cb.Msg
Case %WM_InitDialog
PlayMovieInWindow(hDlg, "bubbles.mov")
Case %WM_Size
GetClientRect hDlg, rc
If IsObject(pIVideoWindow) Then
pIVideoWindow.SetWindowPosition(rc.Left, rc.Top, rc.Right, rc.Bottom)
RedrawWindow hDlg, rc, 0, %RDW_INVALIDATE Or %RDW_UPDATENOW
End If
End Select
End Function
Sub PlayMovieInWindow (ByVal hwnd As Dword, ByRef wszFileName As WStringZ)
Local hr As Long
pIGraphBuilder = NewCom ClsId $CLSID_FilterGraph ' Create an instance of the IGraphBuilder object
pIMediaControl = pIGraphBuilder ' Get reference pointers
pIMediaEventEx = pIGraphBuilder
pIVideoWindow = pIGraphBuilder
hr = pIGraphBuilder.RenderFile(wszFileName) ' Render the file
pIVideoWindow.Owner = hwnd
pIVideoWindow.WindowStyle = %WS_Child Or %WS_ClipSiblings Or %WS_ClipChildren
pIMediaControl.Run ' Run the graph
End Sub
=============================================================
GetCameraList #1
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
#Include Once "dshow.inc"
Global CameraCount As Long, CameraList$
Function PBMain() As Long
GetCameraList
? "Cameras: " + Str$(CameraCount) + $CrLf + CameraList$
End Function
Sub GetCameraList 'stops enumeration on moniker which has the friendly name
Local pceltFetched As Dword, pwszDisplayName As WStringZ Ptr, varName As Variant
Local pSysDevEnum As ICreateDevEnum
Local pEnumCat As IEnumMoniker
Local pMoniker As IMoniker
Local pPropBag As IPropertyBag
Local pbc As IBindCTX
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
End Sub
==========================================================
DisplayFirstCamera #2
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
#Include Once "dshow.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
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
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
==========================================
DisplayNamedCamera #3
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
#Debug Error On
#Debug Display On
%Unicode = 1
#Include "Win32API.inc"
#Include Once "dshow.inc"
'$Camera = "TX-1/LX-1"
$Camera = "Logitech HD Pro Webcam C920"
Global hDlg, CameraFound 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 pCap As IBaseFilter 'Video capture filter
Global pPropBag As IPropertyBag
Global pControl As IMediaControl
Global pWindow As IVideoWindow 'Display Window
Function PBMain() As Long
Dialog New Pixels, 0, "Video Preview",,,600,400, %WS_SysMenu 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
GetMatchingMoniker
If CameraFound Then DisplayNamedCamera
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, "Camera Not Found!"
End If
End Select
End Function
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,$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_ClipSiblings Or %WS_ClipChildren 'video window settings
pControl = pGraph
pControl.Run
End Sub
Sub GetMatchingMoniker 'stops enumeration on moniker which has the friendly name
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 CameraFound = 1 : Exit Do
Loop
End Sub
=========================================
Get/Set Settings #4
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
#Include Once "dshow.inc"
#Include "cgdiplus.inc"
Type CameraSettings
name As StringZ * 25
max As Long
min As Long
dstep As Long
cstep As Long
val As Long
default As Long
type As Long
auto As Long
delta As Long
End Type
Enum Equates Singular
IDC_ListView = 500
IDC_Plus
IDC_Minus
IDC_Reset
IDC_Refresh
IDC_Print
End Enum
Global hDlg,hListView,hBorderBrush As Dword, CameraRC As Rect
Global wMod,hMod,CameraCount,wTrue,hTrue As Long
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 pCap As IBaseFilter 'Video capture filter
Global pControl As IMediaControl
Global pWindow As IVideoWindow 'Display Window
Global pProcAmp As IAMVideoProcAmp 'backlight comp, brightness, contrast, gain, gamme, hue, saturation, sharpness, whitebalance
Global pCamControl As IAMCameraControl 'exposure, focus, zoom
Global pPropBag As IPropertyBag
Global pbc As IBindCTX
Global Q() As CameraSettings
Function PBMain() As Long
Dialog Default Font "Tahoma", 12, 1
Dialog New Pixels, 0, "",,,1000,420, %WS_OverlappedWindow Or %WS_ClipChildren To hDlg
Control Add Button, hDlg, %IDC_Plus,"Plus",10,10,60,25
Control Add Button, hDlg, %IDC_Minus,"Minus",75,10,60,25
Control Add Button, hDlg, %IDC_Reset,"Reset",140,10,60,25
Control Add Button, hDlg, %IDC_Refresh,"Refresh",215,10,60,25
Control Add Button, hDlg, %IDC_Print,"Print",290,10,60,25
CreateListView
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local w,h As Long, hDC As Dword, PS As PaintStruct
Select Case Cb.Msg
Case %WM_InitDialog
DisplayFirstCamera
pProcAmp = pCap
pCamControl = pCap
GetSettings
LoadListView(1)
Case %WM_Size : ResizeWindow
Case %WM_Paint
Dialog Get Client hDlg To w,h
hDC = BeginPaint(hDlg, PS)
hBorderBrush = CreateSolidBrush(%Black)
FillRect(hDC, CameraRC, hBorderBrush)
EndPaint hDlg, PS
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Plus : ChangeSetting(+1) '+1 means increase setting value
Case %IDC_Minus : ChangeSetting(-1) '-1 means decrease setting value
Case %IDC_Reset : ResetCameraSettings
Case %IDC_Refresh : RefreshCameraSettings
Case %IDC_Print : PrintDialog
End Select
End Select
End Function
Sub CreateListView
Local w,h As Long
Dialog Get Client hDlg To w,h
Control Add ListView, hDlg, %IDC_ListView, "", 0,40,100,100, %WS_TabStop Or %LVS_Report Or %LVS_ShowSelAlways Or %LVS_SingleSel, %WS_Ex_ClientEdge
Control Handle hDlg, %IDC_ListView To hListView
ListView Insert Column hDlg, %IDC_ListView, 1, "Setting" , 120 , 0
ListView Insert Column hDlg, %IDC_ListView, 2, "Min", 60 , 0
ListView Insert Column hDlg, %IDC_ListView, 3, "Val", 60 , 0
ListView Insert Column hDlg, %IDC_ListView, 4, "Max", 60 , 0
ListView Insert Column hDlg, %IDC_ListView, 5, "DStep", 60 , 0
ListView Insert Column hDlg, %IDC_ListView, 6, "CStep", 60 , 0
ListView Insert Column hDlg, %IDC_ListView, 7, "Flags", 60 , 0
ListView Set StyleXX hDlg, %IDC_ListView, %LVS_Ex_FullRowSelect Or %LVS_Ex_GridLines
End Sub
Sub DisplayFirstCamera
Local pceltFetched As Dword, pwszDisplayName As WStringZ Ptr, varName As Variant
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.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
Dialog Set Text hDlg, Variant$$(varName)
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
CameraCount = 1
End Sub
Sub LoadListView(iRow As Long)
Local i As Long
ListView Reset hDlg, %IDC_ListView
If CameraCount Then
For i = 1 To UBound(Q)
ListView Insert Item hDlg, %IDC_ListView, i,0, Q(i).name
ListView Set Text hDlg, %IDC_ListView, i, 2, Str$(Q(i).min)
ListView Set Text hDlg, %IDC_ListView, i, 3, Str$(Q(i).val)
ListView Set Text hDlg, %IDC_ListView, i, 4, Str$(Q(i).max)
ListView Set Text hDlg, %IDC_ListView, i, 5, Str$(Q(i).dstep)
ListView Set Text hDlg, %IDC_ListView, i, 6, Str$(Q(i).cstep)
ListView Set Text hDlg, %IDC_ListView, i, 7, Str$(Q(i).auto)
Next i
Else
ListView Insert Item hDlg, %IDC_ListView, 1, 0, "No Cameras Found"
End If
ListView Select hDlg, %IDC_ListView, iRow
ListView_SetItemState hListView, iRow-1, %LVIS_Focused, %LVIS_Focused '<--- synchronizing code
Control Set Focus hDlg, %IDC_ListView
End Sub
Sub ResizeWindow
Local x0,y0,w,h,wCont,hCont As Long
Local xImg,yImg,BorderFrame,BorderSize As Long, Factor As Single
Dialog Get Client hDlg To w,h
Control Set Loc hDlg, %IDC_ListView, 10, 40
Control Set Size hDlg, %IDC_ListView, 485, h-45
wTrue = 800 : hTrue = 600 'camera resolution (assumption)
BorderSize = 10 : Factor = 1.0 : BorderFrame = 3
x0 = 485 + 2*BorderSize
y0 = BorderSize
wCont = w - x0 - BorderSize 'width
hCont = h - 2*BorderSize 'height
wMod = wTrue / Max(wTrue / wCont, hTrue / hCont)
hMod = hTrue / Max(wTrue / wCont, hTrue / hCont)
xImg = x0 + (wCont-wMod)/2 + (1-Factor)*wCont/2
yIMg = y0 + (hCont-hMod)/2 + (1-Factor)*hCont/2 'upper/left position so resized image is centered
If CameraCount Then pWindow.SetWindowPosition(xImg,yImg,wMod,hMod)
CameraRC.nLeft = xImg - BorderFrame
CameraRC.nTop = yImg - BorderFrame
CameraRC.nRight = CameraRC.nLeft + wMod + 2*BorderFrame
CameraRC.nBottom = CameraRC.nTop + hMod + 2*BorderFrame
Dialog ReDraw hDlg
End Sub
Sub PrintDialog
Local PrinterOrientation, BX, BY As Long
Local x,y,w,h,wNew,hNew,wCont,hCont As Long
Local hDC_Dialog, hDC_Printer As Dword
'Select Printer
XPrint Attach Default
If Len(XPrint$)=0 Then Exit Sub
'Get Printer Properties
XPrint Get Client To wCont, hCont
XPrint Get DC To hDC_Printer
hDC_Dialog = GetWindowDC (hDlg)
'get new dimensions
BX = GetSystemMetrics(%SM_CXSizeFrame)
BY = GetSystemMEtrics(%SM_CYSizeFrame)
Dialog Get Size hDlg To w,h
wNew = w/Max(w/wCont,h/hCont)
hNew = h/Max(w/wCont,h/hCont)
x = (wCont-wNew)/2 : y = (hCont-hNew)/2 'upper/left position so resized image is centered
'Print
PrinterOrientation = 1
XPrint Get Orientation To PrinterOrientation
StretchBlt hDC_Printer,x,y,wNew,hNew, hDC_Dialog,BX,BY,w-2*BX,h-2*BY, %SRCCopy
ReleaseDC hDlg, hDC_Dialog
XPrint Close
End Sub
Sub GetSettings
Local i As Long
Dim QName(17) As String
Dim QDelta(17) As Long
Dim QType(17) As Long
Array Assign QName() = "","Brightness","Contrast","Hue","Saturation","Sharpness","Gamma","ColorEnable","White Balance","Compensation","Gain", _
"Pan","Tilt","Roll","Zoom","Exposure", "Iris", "Focus"
Array Assign QDelta() = 0,12,12,12,12,12,12,12,300,1,12, 1,1,1,40,1,1,25
Array Assign QType() = 0,%VideoProcAmp_Brightness,%VideoProcAmp_Contrast,%VideoProcAmp_Hue,%VideoProcAmp_Saturation, %VideoProcAmp_ColorEnable, _
%VideoProcAmp_Sharpness,%VideoProcAmp_Gamma,%VideoProcAmp_WhiteBalance,%VideoProcAmp_BacklightCompensation,%VideoProcAmp_Gain, _
%CameraControl_Pan,%CameraControl_Tilt,%CameraControl_Roll,%CameraControl_Zoom, %CameraControl_Exposure,%CameraControl_Iris, %CameraControl_Focus
pProcAmp = pCap
pCamControl = pCap
ReDim Q(17)
For i = 1 To 10 '1-10 are quality setting pProcAmp : 11-17 are Camera control settings
Q(i).name = QName(i)
Q(i).delta = QDelta(i)
Q(i).type = QType(i)
Q(i).cstep = QDelta(i)
pProcAmp.GetRange(QType(i), Q(i).Min, Q(i).Max, Q(i).dStep, Q(i).Default, Q(i).Auto)
pProcAmp.Get(QType(i), Q(i).Val, Q(i).Auto)
Next i
For i = 11 To 17
Q(i).name = QName(i)
Q(i).delta = QDelta(i)
Q(i).type = QType(i)
Q(i).cstep = QDelta(i)
pCamControl.GetRange(Q(i).type, Q(i).Min, Q(i).Max, Q(i).dStep, Q(i).Default, Q(i).Auto)
pCamControl.Get(Q(i).type, Q(i).Val, Q(i).Auto)
Next i
End Sub
Sub RefreshCameraSettings
Local iRow As Long
ListView Get Select hDlg, %IDC_ListView To iRow
GetSettings
LoadListView(iRow)
End Sub
Sub ResetCameraSettings
Local i,iRow As Long
ListView Get Select hDlg, %IDC_ListView To iRow
For i = 1 To 10 : pProcAmp.Set(Q(i).type, Q(i).default, 0) : Next i
For i = 11 To 17 : pCamControl.Set(Q(i).type, Q(i).default, 0) : Next i
GetSettings
LoadListView(iRow)
End Sub
Sub ChangeSetting(iDirection As Long)
Local iNew,iRow As Long
ListView Get Select hDlg, %IDC_ListView To iRow
If iRow = 0 Then Exit Sub
iNew = Q(iRow).val + iDirection * Q(iRow).Delta
If iNew < Q(iRow).min Then iNew = Q(iRow).min
If iNew > Q(iRow).max Then iNew = Q(iRow).max
If iRow < 11 Then pProcAmp.Set(Q(iRow).type, iNew, 0)
If iRow > 10 Then pCamControl.Set(Q(iRow).type, iNew, 0)
GetSettings
LoadListView(iRow)
End Sub
===============================================================
Get Supported Formats #5
'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
===============================================================
Modify Frame In-Stream (ISampleGrabber) #6
'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