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 "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
http://www.garybeene.com/sw/gbsnippets.htm