Get/Set Settings #4

Category: Direct Show

Date: 02-16-2022

Return to Index

'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
#Include ""
#Include Once ""
#Include ""
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
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
   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
         pProcAmp    = pCap
         pCamControl = pCap
      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, pMoniker, pceltFetched)                               'cycle through monikders
   pMoniker.GetDisplayName(pbc, Nothing, pwszDisplayName)                 'get complex camera name
   pMoniker.BindToStorage(NothingNothing, $IID_IPropertyBag, pPropBag)  'get info about Moniker
   pPropBag.Read("FriendlyName", varName, Nothing)                        'get friendly name
   Dialog Set Text hDlg, Variant$$(varName)
   pMoniker.BindToObject(NothingNothing, $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, NothingNothing   'render the live source
   pWindow = pGraph : pWindow.Owner = hDlg : pWindow.WindowStyle = %WS_Child Or %WS_ClipChildren  'video window settings
   pControl = pGraph
   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
      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
   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
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
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)
End Sub

created by gbSnippets