Jump to content

Take Picture with Camera App Windows 10


 Share

Recommended Posts

Hi all,

I am using a Camera UDF for windows 10 found in the Forum by Frank10 and modified by Belini.

It fails to parse a _WebcamSnap Function taken form another pretty old UDF.

can someone help to fix this function only. the rest of the script is working fine

;=============================================Here is the problem======================================================
Func _WebcamSnap($sId, $sFile)
    DllCall($user, "int", "SendMessage", "hWnd", $sId, "int", $WM_CAP_SET_CALLBACK_FRAME, "int", 0, "int", 0)
    DllCall($user, "int", "SendMessage", "hWnd", $sId, "int", $WM_CAP_GRAB_FRAME_NOSTOP, "int", 0, "int", 0)
    DllCall($user, "int", "SendMessage", "hWnd", $sId, "int", $WM_CAP_FILE_SAVEDIBA, "int", 0, "str", $sFile)
    if @error Then
        return 0
    Else
        return 1
    EndIf
EndFunc

All Script ode is below :

#include <GuiComboBox.au3>
#include <ScreenCapture.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include  <Misc.au3>

Opt("MustDeclareVars", 1)
#AutoIt3Wrapper_Au3Check_Parameters=-q -d -w 1 -w 2 -w 3 -w 4 -w 5 -w 6 -w 7

; #VARIABLES#
Global Const $S_OK = 0
Global Const $WM_CAP_START = 0x400
Global Const $WM_CAP_GRAB_FRAME_NOSTOP = $WM_CAP_START + 61
Global Const $WM_CAP_SET_CALLBACK_FRAME = $WM_CAP_START + 35
Global Const $WM_CAP_FILE_SAVEDIBA = $WM_CAP_START + 25
Global Const $WM_CAP_SET_PREVIEW = $WM_CAP_START + 50
Global Const $WM_CAP_SET_PREVIEWRATE = $WM_CAP_START + 52
Global Const $WM_CAP_DRIVER_CONNECT = $WM_CAP_START + 10
Global Const $WM_CAP_SET_SCALE = $WM_CAP_START + 53
Global Const $WM_CAP_SET_OVERLAY = $WM_CAP_START + 51
Global $Vmr9 = 1, $oVideoWindow, $oVmr9, $aWebcamList[9]
Global $avi = DllOpen("avicap32.dll")
Global $user = DllOpen("user32.dll")
Global $oBasicVideo, $oBuild, $oCapture[9], $oGraph, $oMediaControl, $oDevEnum, $oEnum
Global Const $sIID_IMediaControl = '{56A868B1-0AD4-11CE-B03A-0020AF0BA770}'
Global Const $sCLSID_VideoInputDeviceCategory = '{860bb310-5d01-11d0-bd3b-00a0c911ce86}'
Global Const $PIN_CATEGORY_CAPTURE = '{fb6c4281-0353-11d1-905f-0000c0cc16ba}'
Global Const $PIN_CATEGORY_PREVIEW = '{fb6c4282-0353-11d1-905f-0000c0cc16ba}'
Global Const $MEDIATYPE_Video = '{73646976-0000-0010-8000-00aa00389b71}'
Global Const $sCLSID_VideoMixingRenderer9 = '{51b4abf3-748f-4e3b-a276-c828330e926a}'
Global Const $sCLSID_FilterGraph = "{E436EBB3-524F-11CE-9F53-0020AF0BA770}"
Global Const $sIID_IGraphBuilder = "{56A868A9-0AD4-11CE-B03A-0020AF0BA770}"
Global Const $tagIGraphBuilder = "AddFilter hresult(ptr;wstr);" & "RemoveFilter hresult(ptr);" & "EnumFilters hresult(ptr*);" & "FindFilterByName hresult(wstr;ptr*);" & "ConnectDirect hresult(ptr;ptr;ptr);" & "Reconnect hresult(ptr);" & "Disconnect hresult(ptr);" & "SetDefaultSyncSource hresult();" & "Connect hresult(ptr;ptr);" & "Render hresult(ptr);" & "RenderFile hresult(wstr;ptr);" & "AddSourceFilter hresult(wstr;wstr;ptr*);" & "SetLogFile hresult(dword_ptr);" & "Abort hresult();" & "ShouldOperationContinue hresult();"
Global Const $sCLSID_CaptureGraphBuilder2 = '{BF87B6E1-8C27-11D0-B3F0-00AA003761C5}'
Global Const $sIID_ICaptureGraphBuilder2 = '{93e5a4e0-2d50-11d2-abfa-00a0c9c6e38d}'
Global Const $tagICaptureGraphBuilder2 = "SetFiltergraph hresult(ptr);" & "GetFiltergraph hresult(ptr*);" & "SetOutputFileName hresult(clsid;wstr;ptr*;ptr*);" & "FindInterface hresult(clsid;clsid;ptr;clsid;ptr*);" & "RenderStream hresult(clsid;clsid;ptr;ptr;ptr);" & "ControlStream hresult(clsid;clsid;ptr;ptr;ptr;word;word);" & "AllocCapFile hresult(wstr;int64);" & "CopyCaptureFile hresult(wstr;wstr;int;ptr*);" & "FindPin hresult(ptr;int;clsid;clsid;bool;int;ptr*);"
Global Const $sCLSID_SystemDeviceEnum = '{62BE5D10-60EB-11d0-BD3B-00A0C911CE86}'
Global Const $sIID_ICreateDevEnum = '{29840822-5b84-11d0-bd3b-00a0c911ce86}'
Global Const $tagICreateDevEnum = "CreateClassEnumerator hresult( clsid ; ptr*; dword );"
Global Const $sIID_IEnumMoniker = '{00000102-0000-0000-c000-000000000046}'
Global Const $tagIEnumMoniker = "Next hresult(dword;ptr*;dword*);" & "Skip hresult(dword);" & "Reset hresult();" & "Clone hresult(ptr*);"
Global Const $sIID_IBaseFilter = '{56a86895-0ad4-11ce-b03a-0020af0ba770}'
Global Const $tagIBaseFilter = "GetClassID hresult(ptr*);" & "Stop hresult();" & "Pause hresult();" & "Run hresult(int64);" & "GetState hresult(dword;dword*);" & "SetSyncSource hresult(ptr);" & "GetSyncSource hresult(ptr*);" & "EnumPins hresult(ptr*);" & "FindPin hresult(wstr;ptr*);" & "QueryFilterInfo hresult(ptr*);" & "JoinFilterGraph hresult(ptr;wstr);" & "QueryVendorInfo hresult(wstr*);"
Global Const $sIID_IMoniker = '{0000000f-0000-0000-C000-000000000046}'
Global Const $tagIMoniker = "GetClassID hresult( clsid )" & "IsDirty hresult(  );" & "Load hresult( ptr );" & "Save hresult( ptr, bool );" & "GetSizeMax hresult( uint64 );" & "BindToObject hresult( ptr;ptr;clsid;ptr*);" & "BindToStorage hresult( ptr;ptr;clsid;ptr*);" & "Reduce hresult( ptr;dword;ptr*;ptr*);" & "ComposeWith hresult( ptr;bool;ptr*);" & "Enum hresult( bool;ptr*);" & "IsEqual hresult( ptr);" & "Hash hresult( dword*);" & "IsRunning hresult( ptr;ptr;ptr);" & "GetTimeOfLastChange hresult( ptr;ptr;int64*);" & "Inverse hresult( ptr*);" & "CommonPrefixWith hresult( ptr;ptr*);" & "RelativePathTo hresult( ptr;ptr*);" & "GetDisplayName hresult( ptr;ptr;wstr*);" & "ParseDisplayName hresult( ptr;ptr;wstr;ulong*;ptr*);" & "IsSystemMoniker hresult( dword*);"
Global Const $tagIDispatch = "GetTypeInfoCount hresult(dword*);" & "GetTypeInfo hresult(dword;dword;ptr*);" & "GetIDsOfNames hresult(clsid;ptr;dword;dword;ptr);" & "Invoke hresult(dword;clsid;dword;word;ptr;ptr;ptr;dword*);"
Global Const $sIID_IVideoWindow = "{56A868B4-0AD4-11CE-B03A-0020AF0BA770}"
Global Const $tagIVideoWindow = $tagIDispatch & "put_Caption hresult(bstr);" & "get_Caption hresult(bstr*);" & "put_WindowStyle hresult(long);" & "get_WindowStyle hresult(long*);" & "put_WindowStyleEx hresult(long);" & "put_WindowStyleEx hresult(long*);" & "put_AutoShow hresult(long);" & "get_AutoShow hresult(long*);" & "put_WindowState hresult(long);" & "get_WindowState hresult(long*);" & "put_BackgroundPalette hresult(long);" & "get_BackgroundPalette hresult(long*);" & "put_Visible hresult(long);" & "get_Visible hresult(long*);" & "put_Left hresult(long);" & "get_Left hresult(long*);" & "put_Width hresult(long);" & "get_Width hresult(long*);" & "put_Top hresult(long);" & "get_Top hresult(long*);" & "put_Height hresult(long);" & "get_Height hresult(long*);" & "put_Owner hresult(long_ptr);" & "get_Owner hresult(long_ptr*);" & "put_MessageDrain hresult(long_ptr);" & "get_MessageDrain hresult(long_ptr*);" & "get_BorderColor hresult(long*);" & "put_BorderColor hresult(long);" & "get_FullScreenMode hresult(long*);" & "put_FullScreenMode hresult(long);" & "SetWindowForeground hresult(long);" & "NotifyOwnerMessage hresult(long_ptr;long;long_ptr;long_ptr);" & "SetWindowPosition hresult(long;long;long;long);" & "GetWindowPosition hresult(long*;long*;long*;long*);" & "GetMinIdealImageSize hresult(long*;long*);" & "GetMaxIdealImageSize hresult(long*;long*);" & "GetRestorePosition hresult(long*;long*;long*;long*);" & "HideCursor hresult(long);" & "IsCursorHidden hresult(long*);"
Global Const $sIID_IBasicVideo = "{56A868B5-0AD4-11CE-B03A-0020AF0BA770}"
Global Const $tagIBasicVideo = $tagIDispatch & "get_AvgTimePerFrame hresult(double*);" & "get_BitRate hresult(long*);" & "get_BitErrorRate hresult(long*);" & "get_VideoWidth hresult(long*);" & "get_VideoHeight hresult(long*);" & "put_SourceLeft hresult(long);" & "get_SourceLeft hresult(long*);" & "put_SourceWidth hresult(long);" & "get_SourceWidth hresult(long*);" & "put_SourceTop hresult(long);" & "get_SourceTop hresult(long*);" & "put_SourceHeight hresult(long);" & "get_SourceHeight hresult(long*);" & "put_DestinationLeft hresult(long);" & "get_DestinationLeft hresult(long*);" & "put_DestinationWidth hresult(long);" & "get_DestinationWidth hresult(long*);" & "put_DestinationTop hresult(long);" & "get_DestinationTop hresult(long*);" & "put_DestinationHeight hresult(long);" & "get_DestinationHeight hresult(long*);" & "SetSourcePosition hresult(long;long;long;long);" & "GetSourcePosition hresult(long*;long*;long*;long*);" & "SetDefaultSourcePosition hresult();" & "SetDestinationPosition hresult(long;long;long;long);" & "GetDestinationPosition hresult(long*;long*;long*;long*);" & "SetDefaultDestinationPosition hresult();" & "GetVideoSize hresult(long*;long*);" & "GetVideoPaletteEntries hresult(long;long;long*;long*);" & "GetCurrentImage hresult(long*;long*);" & "IsUsingDefaultSource hresult();" & "IsUsingDefaultDestination hresult();"
Global Const $sIID_IPropertyBag = '{55272a00-42cb-11ce-8135-00aa004bb851}'
Global Const $tagIPropertyBag = 'Read hresult(wstr;variant*;ptr*);' & 'Write hresult(wstr;variant);'
Global Const $tagIVMRWindowlessControl = 'GetNativeVideoSize hresult(long*;long*;long*;long*);' & 'GetMinIdealVideoSize hresult(long*;long*);' & 'GetMaxIdealVideoSize hresult(long*;long*);' & 'SetVideoPosition hresult(ptr;ptr);' & 'GetVideoPosition hresult(ptr*;ptr*);' & 'GetAspectRatioMode hresult(dword*);' & 'SetAspectRatioMode hresult(dword);' & 'SetVideoClippingWindow hresult(hwnd);' & 'RepaintVideo hresult(hwnd;handle);' & 'DisplayModeChanged hresult();' & 'GetCurrentImage hresult(byte*);' & 'SetBorderColor hresult(clr);' & 'GetBorderColor hresult(clr*);' & 'SetColorKey hresult(clr);' & 'GetColorKey hresult(clr*);'
Global Const $tagIVMRFilterConfig = 'SetImageCompositor hresult(ptr);' & 'GetNumberOfStreams hresult(dword*);' & 'SetRenderingPrefs hresult(dword);' & 'GetRenderingPrefs hresult(dword*);' & 'SetRenderingMode hresult(dword);' & 'GetrenderingMode hresult(dword*);'
Global Const $sIID_IVMRFilterConfig9 = '{5a804648-4f66-4867-9c43-4f5c822cf1b8}'
Global Const $tagIVMRFilterConfig9 = 'SetImageCompositor hresult(ptr);' & 'SetNumberOfStreams hresult(dword);' & 'GetNumberOfStreams hresult(dword*);' & 'SetRenderingPrefs hresult(dword);' & 'GetRenderingPrefs hresult(dword*);' & 'SetRenderingMode hresult(dword);' & 'GetrenderingMode hresult(dword*);'
Global Const $sIID_IVMRMixerControl9 = '{1a777eaa-47c8-4930-b2c9-8fee1c1b0f3b}'
Global Const $tagIVMRMixerControl9 = 'SetAlpha(dword;float);' & 'GetAlpha(dword;ptr*) ;' & 'SetZOrder(dword;dword) ;' & 'GetZOrder(dword;ptr*) ;' & 'SetOutputRect(dword;ptr) ;' & 'GetOutputRect(dword;ptr*) ;' & 'SetBackgroundClr(dword) ;' & 'GetBackgroundClr(ptr) ;' & 'SetMixingPrefs(dword) ;' & 'GetMixingPrefs(ptr*) ;' & 'SetProcAmpControl(dword;ptr) ;' & 'GetProcAmpControl(dword;ptr*) ;' & 'GetProcAmpControlRange(dword;ptr*);'
Global Const $sIID_IAMStreamConfig = '{c6e13340-30ac-11d0-a18c-00a0c9118956}'
Global $FrameRate = 30
; #VARIABLES#

; ================================================================================================== EXAMPLE START
Global $msg, $hGUI, $sId_snap, $idCam, $hComboCam = '', $but_snap, $sFile, $isCamera = 0, $pos_control

Global $iWebcam = IniRead(@ScriptDir & "\tonfig.ini", "WEBCAM", "opt", "1")

_WebcamDS_Init()

If @error <> 0 Or @extended <> 0 Then Exit
_CreateGui(740, 580)

_WebcamDS_RenderWebcam($iWebcam, $hGUI, 0, $pos_control[2], $pos_control[3], $pos_control[0], $pos_control[1])

If @error <> 0 Or @extended <> 0 Then Exit

While 1
    $msg = GUIGetMsg()
    Switch $msg

        Case $but_snap
            ;$sFile = FileSaveDialog("Save", @ScriptDir & "\", "Image (*.bmp)", 1 + 4)
            $sFile = @ScriptDir & "\Picture.bmp"
            _WebcamSnap
        Case $GUI_EVENT_CLOSE
            _WebcamDS_ReleaseObjects(1)
            GUIDelete()
            ExitLoop
    EndSwitch
WEnd

Func _CreateGui($w = 640, $h = 480)
    $hGUI = GUICreate("Test Capture", $w, $h, $WS_POPUP)
    Local $pic_image = GUICtrlCreatePic("", 45, 45, 640, 480)
    GUICtrlSetBkColor(-1, 0xff0000)
    $but_snap = GUICtrlCreateButton("Take picture", 585, 9, 100, 25)
    GUICtrlSetFont(-1, 10, 400, Default, 'arial')
    $pos_control = ControlGetPos("Test Capture", '', $pic_image)

    GUISetState()
EndFunc   ;==>_CreateGui
; ================================================================================================== EXAMPLE END

; #FUNCTION# ====================================================================================================================
; Name...........: _WebcamSnapt
; Description ...: Save current webcam image
; Syntax.........: _WebcamSnap(Image save address, $Gui_id)
; Parameters ....: none
; Return values .: none
; Date...........: 2019/05/11
; Author ........: Belini
; Remarks .......: Call to capture image
; Example .......; Yes
; ===============================================================================================================================

; #FUNCTION# ====================================================================================================================
; Name...........: _WebcamDS_Init
; Description ...: Create Direct Show objects and enumerate webcams
; Syntax.........: _WebcamDS_Init()
; Parameters ....: none
; Return values .: Success - it fills 3 array  $aWebcamList
;                  Failure - Returns 0 and Sets @Error:
;                  |0 - No error.
; Date...........: 2019/05/11
; Author ........: Frank10
; Modified.......: Belini
; Remarks .......: call it at the beginning of the script
; Example .......; Yes
; ===============================================================================================================================
Func _WebcamDS_Init()
    Local $hr
    $oGraph = ObjCreateInterface($sCLSID_FilterGraph, $sIID_IGraphBuilder, $tagIGraphBuilder)
    If Not IsObj($oGraph) Then Return SetError(1, 0, 0)
    $oBuild = ObjCreateInterface($sCLSID_CaptureGraphBuilder2, $sIID_ICaptureGraphBuilder2, $tagICaptureGraphBuilder2)
    If Not IsObj($oBuild) Then Return SetError(2, 0, 0)
    $hr = $oBuild.SetFiltergraph($oGraph)
    If $hr < 0 Then Return SetError(0, 1, 0)
    Local $pMediaControl
    $oGraph.QueryInterface($sIID_IMediaControl, $pMediaControl)
    $oMediaControl = ObjCreateInterface($pMediaControl, $sIID_IMediaControl)
    If Not IsObj($oMediaControl) Then Return SetError(3, 0, 0)
    Local $pVideoWindow
    $oGraph.QueryInterface($sIID_IVideoWindow, $pVideoWindow)
    $oVideoWindow = ObjCreateInterface($pVideoWindow, $sIID_IVideoWindow, $tagIVideoWindow)
    If Not IsObj($oVideoWindow) Then Return SetError(4, 0, 0)
    Local $pBasicVideo
    $oGraph.QueryInterface($sIID_IBasicVideo, $pBasicVideo)
    $oBasicVideo = ObjCreateInterface($pBasicVideo, $sIID_IBasicVideo, $tagIBasicVideo)
    If Not IsObj($oBasicVideo) Then Return SetError(5, 0, 0)

    _WebcamDS_EnumerateDevices($sCLSID_VideoInputDeviceCategory)
    If $aWebcamList[0] > 0 Then
        If $aWebcamList[0] < $iWebcam Or $aWebcamList[0] = 1 Then $iWebcam = 1
    Else
        $iWebcam = 0
        MsgBox(4096, "ALERT", "No camera found", 5)
        exit
    EndIf
EndFunc   ;==>_WebcamDS_Init

; #FUNCTION# ====================================================================================================================
; Name...........: _WebcamDS_ReleaseObjects
; Description ...: release Objects created during script and at the end of it
; Syntax.........: _WebcamDS_ReleaseObjects($iArg = 0)
; Parameters ....: $iArg   - use 0 if you want to delete only the current capture obj, otherwise (ie: at the end) put it to 1
; Return values .: Success - it deletes the objects created
;                  Failure - Returns 0 and Sets @Error:
;                  |0 - No error.
; Date...........: 2019/05/11
; Author ........: Frank10
; Modified.......: Belini
; Example .......; Yes
; ===============================================================================================================================
Func _WebcamDS_ReleaseObjects($iArg = 0)
    $oMediaControl.Stop()
    $oMediaControl = 0
    $oVmr9 = 0
    $oCapture[$iWebcam] = 0
    If $iArg Then $oCapture = 0
    $oBasicVideo = 0
    $oVideoWindow = 0
    $oGraph = 0
    $oBuild = 0
EndFunc   ;==>_WebcamDS_ReleaseObjects

; #FUNCTION# ====================================================================================================================
; Name...........: _WebcamDS_RenderWebcam
; Description ...: call it to set which webcam to display, audio preview, resolution, scale to GUI, zoom
; Syntax.........: _WebcamDS_RenderWebcam($iNumberWebcam=1,$iAudioMic=0,$hGuiWin[,$iScale=1[,$xVideo=640[,$yVideo=480[,$ibpp=16[,$iZoomX=0[,$iZoomY=0[,$iZoomW=0[,$iZoomH=0]]]]]]]])
; Parameters ....: $iNumberWebcam - The webcam to display (from 1)
;                  $hGuiWin     - The GUI you create to display the webcam
;                  $iScale      - if you want to scale the webcam resolution to the res of the GUI, set it to 1, otherwise to 0
;                  $xVideo      - The webcam Width
;                  $yVideo      - The webcam Height
;                  $left        - The left side of image in Gui
;                  $top         - The top side of image in Gui
; Return values .: Success - it displays the webcam selected
;                  Failure - Returns 0 and Sets @Error:
;                  |0 - No error.
; Date...........: 2019/05/11
; Author ........: Frank10
; Modified.......: Belini
; Example .......; Yes
; ===============================================================================================================================
Func _WebcamDS_RenderWebcam($iNumberWebcam, $hGuiWin, $iScale = 1, $xVideo = 640, $yVideo = 480, $left = 0, $top = 0)
    _WebcamDS_EnumerateDevices($sCLSID_VideoInputDeviceCategory, $iNumberWebcam)
    Local $_GUID = "DWORD Data1;" & "WORD  Data2;" & "WORD  Data3;" & "BYTE  Data4[8];"
    Local $_SIZE = "LONG cx;" & "LONG cy;"
    Local $_VIDEO_STREAM_CONFIG_CAPS = $_GUID & "ULONG    VideoStandard;" & $_SIZE & $_SIZE & $_SIZE & "int      CropGranularityX;" & "int      CropGranularityY;" & "int      CropAlignX;" & "int      CropAlignY;" & $_SIZE & $_SIZE & "int      OutputGranularityX;" & "int      OutputGranularityY;" & "int      StretchTapsX;" & "int      StretchTapsY;" & "int      ShrinkTapsX;" & "int      ShrinkTapsY;" & "int64     MinFrameInterval;" & "int64  MaxFrameInterval;" & "LONG     MinBitsPerSecond;" & "LONG     MaxBitsPerSecond;"
    Local $tVideoStream = DllStructCreate($_VIDEO_STREAM_CONFIG_CAPS)
    Local $_AM_MEDIA = $_GUID & $_GUID & 'BOOL  bFixedSizeSamples;' & 'BOOL  bTemporalCompression;' & 'ULONG    lSampleSize;' & $_GUID & 'ptr pUnk;' & 'ULONG    cbFormat;' & 'ptr  pbFormat;'
    Local $t_AM_MEDIA = DllStructCreate($_AM_MEDIA)
    Local $_RECT = 'LONG left;' & 'LONG top;' & 'LONG right;' & 'LONG bottom;'
    Local $_tagBITMAPINFOHEADER = 'DWORD biSize;' & 'LONG  biWidth;' & 'LONG  biHeight;' & 'WORD  biPlanes;' & 'WORD  biBitCount;' & 'DWORD biCompression;' & 'DWORD biSizeImage;' & 'LONG  biXPelsPerMeter;' & 'LONG  biYPelsPerMeter;' & 'DWORD biClrUsed;' & 'DWORD biClrImportant;'
    Local $_tagVIDEOINFOHEADER = $_RECT & $_RECT & 'DWORD            dwBitRate;' & 'DWORD            dwBitErrorRate;' & 'int64   AvgTimePerFrame;' & $_tagBITMAPINFOHEADER
    Local $hr = $oBuild.FindInterface($PIN_CATEGORY_CAPTURE, $MEDIATYPE_Video, $oCapture[$iNumberWebcam], $sIID_IAMStreamConfig, 0)
    Local $iCount = 0, $iSize = 0
    If $hr < 0 Then Return SetError(1, 7, 0)
    If DllStructGetSize($tVideoStream) == $iSize Then
        For $iFormat = 0 To $iCount - 1 Step 1
            Local $pmtConfig = DllStructGetPtr($t_AM_MEDIA)
            Local $t_AM_MEDIA_TYPE = DllStructCreate($_AM_MEDIA, $pmtConfig)
            Local $pbFormat = DllStructGetData($t_AM_MEDIA_TYPE, "pbFormat")
            Local $t_VIDEOINFOHEADER = DllStructCreate($_tagVIDEOINFOHEADER, $pbFormat)
            Local $biCompression = DllStructGetData($t_VIDEOINFOHEADER, 'biCompression')
            Local $sText = ''
            For $i = 7 To 0 Step -2
                If $biCompression <> 0 Then $sText = $sText & Chr(Dec(StringMid(Hex($biCompression, 8), $i, 2)))
            Next
            DllStructSetData($t_VIDEOINFOHEADER, 'AvgTimePerFrame', 10000000 / $FrameRate)
            If $iFormat = $iCount - 1 Then
                DllStructSetData($t_VIDEOINFOHEADER, 'biWidth', $xVideo)
                DllStructSetData($t_VIDEOINFOHEADER, 'biHeight', $yVideo)
                DllStructSetData($t_VIDEOINFOHEADER, 'biBitCount', 16)
                If $hr < 0 Then Return SetError(1, 9, 0)
            EndIf
        Next
    EndIf
    If $Vmr9 = 0 Then
        $hr = $oBuild.RenderStream($PIN_CATEGORY_PREVIEW, $MEDIATYPE_Video, $oCapture[$iNumberWebcam], 0, 0)
        If $hr < 0 Then Return SetError(1, 10, 0)
    Else
        $oVmr9 = ObjCreateInterface($sCLSID_VideoMixingRenderer9, $sIID_IBaseFilter, $tagIBaseFilter)
        If Not IsObj($oVmr9) Then Return SetError(14, 0, 0)
        $hr = $oGraph.AddFilter($oVmr9, "VMR9")
        If $hr < 0 Then Return SetError(1, 11, 0)
        Local $pConfig9, $oConfig9
        $hr = $oVmr9.QueryInterface($sIID_IVMRFilterConfig9, $pConfig9)
        $oConfig9 = ObjCreateInterface($pConfig9, $sIID_IVMRFilterConfig9, $tagIVMRFilterConfig9)
        If Not IsObj($oConfig9) Then Return SetError(15, 0, 0)
        ConsoleWrite('Filterconf hr:' & $hr & '  ' & IsObj($oConfig9) & @CRLF)
        $hr = $oConfig9.SetNumberOfStreams(4)
        If $hr < 0 Then Return SetError(1, 12, 0)
        Local $pMixControl9, $oMixControl9
        $hr = $oVmr9.QueryInterface($sIID_IVMRMixerControl9, $pMixControl9)
        $oMixControl9 = ObjCreateInterface($pMixControl9, $sIID_IVMRMixerControl9, $tagIVMRMixerControl9)
        If Not IsObj($oMixControl9) Then Return SetError(16, 0, 0)
        Local $t_VMR9rect = DllStructCreate($_RECT)
        Local $l = 0, $t = 0, $r = $l + $xVideo, $b = $t + $yVideo
        DllStructSetData($t_VMR9rect, 'left', $l)
        DllStructSetData($t_VMR9rect, 'top', $t)
        DllStructSetData($t_VMR9rect, 'right', $r)
        DllStructSetData($t_VMR9rect, 'bottom', $b)
        $oConfig9 = 0
        $oMixControl9 = 0
        $hr = $oBuild.RenderStream($PIN_CATEGORY_PREVIEW, $MEDIATYPE_Video, $oCapture[$iNumberWebcam], 0, $oVmr9)
        If $hr < 0 Then Return SetError(1, 14, 0)
        $oVmr9 = 0
    EndIf
    Local $iX = $left, $iY = $top
    Local $aClientSize = WinGetClientSize($hGuiWin)
    If $iScale = 1 Then
        $xVideo = $aClientSize[0]
        $yVideo = $aClientSize[1]
    EndIf
    $hr = $oVideoWindow.SetWindowPosition($iX, $iY, $xVideo, $yVideo)
    If $hr < 0 Then Return SetError(1, 16, 0)
    $hr = $oVideoWindow.put_Owner($hGuiWin)
    If $hr < 0 Then Return SetError(1, 17, 0)
    $oVideoWindow.put_WindowStyle(BitOR($WS_CHILD, $WS_CLIPCHILDREN))
    If $hr < 0 Then Return SetError(1, 18, 0)
    $hr = $oMediaControl.Run()
    If $hr < 0 Then Return SetError(1, 19, 0)
EndFunc   ;==>_WebcamDS_RenderWebcam

; #INTERNAL_NO_DOC# ===================================================================================================
Func _WebcamDS_EnumerateDevices($CLSID_category, $argument = 99)
    $oDevEnum = ObjCreateInterface($sCLSID_SystemDeviceEnum, $sIID_ICreateDevEnum, $tagICreateDevEnum)

    If Not IsObj($oDevEnum) Then Return SetError(6, 0, 0)
    Local $pEnum = 0
    $oDevEnum.CreateClassEnumerator($CLSID_category, $pEnum, 0)
    $oEnum = ObjCreateInterface($pEnum, $sIID_IEnumMoniker, $tagIEnumMoniker)

    If Not IsObj($oEnum) Then Return SetError(7, 0, 0)
    Local $iPosition = '', $arg = ''
    If StringInStr($CLSID_category, "860bb310") Or StringInStr($CLSID_category, "33d9a762") Then
        $iPosition = $argument
        $arg = ''
    Else
        $iPosition = ''
        $arg = $argument
    EndIf
    Local $pMoniker, $oMoniker, $hr
    Local $i = 1, $pBindObj[99]
    While $oEnum.Next(1, $pMoniker, 0) = $S_OK
        Local $pPropBag, $oPropBag
        $oMoniker = ObjCreateInterface($pMoniker, $sIID_IMoniker, $tagIMoniker)
        If Not IsObj($oMoniker) Then Return SetError(8, 0, 0)
        $hr = $oMoniker.BindToObject(0, 0, $sIID_IBaseFilter, $pBindObj[$i])
        If $hr < 0 Then ExitLoop
        $hr = $oMoniker.BindToStorage(0, 0, $sIID_IPropertyBag, $pPropBag)
        If $hr < 0 Then Return SetError(1, 2, 0)
        $oPropBag = ObjCreateInterface($pPropBag, $sIID_IPropertyBag, $tagIPropertyBag)
        If Not IsObj($oPropBag) Then Return SetError(9, 0, 0)
        Local $var = 'test'
        $hr = $oPropBag.Read("FriendlyName", $var, 0)
        If $hr < 0 Then Return SetError(1, 3, 0)
        If $iPosition = 99 Then
            If $var <> '' Then
                $aWebcamList[$i] = $var
            EndIf
        EndIf
        If ($iPosition <> '' And $iPosition = $i) Or ($arg <> '' And $var = $arg) Then
            If ($iPosition <> '' And $iPosition = $i) Then
                If Not IsObj($oCapture[$iPosition]) Then
                    $oCapture[$iPosition] = ObjCreateInterface($pBindObj[$i], $sIID_IBaseFilter, $tagIBaseFilter)
                    If Not IsObj($oCapture[$iPosition]) Then Return SetError(12, 0, 0)
                EndIf
                $hr = $oGraph.AddFilter($oCapture[$iPosition], "CaptureFilter" & $iWebcam)
                If $hr < 0 Then Return SetError(1, 6, 0)
                WinSetTitle($hGUI, '', $var)
                ExitLoop
            EndIf
        EndIf
        $oPropBag = 0
        $i += 1
    WEnd
    If $iPosition = 99 And StringInStr($CLSID_category, "860bb310") Then $aWebcamList[0] = $i - 1
    $oMoniker = 0
    $oEnum = 0
    $oDevEnum = 0
EndFunc   ;==>_WebcamDS_EnumerateDevices

Func _WebcamDS_Reset()
    _WebcamDS_ReleaseObjects()
    _WebcamDS_Init()
EndFunc   ;==>_WebcamDS_Reset
;=============================================Here is the problem======================================================
Func _WebcamSnap($sId, $sFile)
    DllCall($user, "int", "SendMessage", "hWnd", $sId, "int", $WM_CAP_SET_CALLBACK_FRAME, "int", 0, "int", 0)
    DllCall($user, "int", "SendMessage", "hWnd", $sId, "int", $WM_CAP_GRAB_FRAME_NOSTOP, "int", 0, "int", 0)
    DllCall($user, "int", "SendMessage", "hWnd", $sId, "int", $WM_CAP_FILE_SAVEDIBA, "int", 0, "str", $sFile)
    if @error Then
        return 0
    Else
        return 1
    EndIf
EndFunc

 

Edited by mikestern
Link to comment
Share on other sites

  • mikestern changed the title to Take Picture with Camera App Windows 10

Also make sure your windows camera settings are set to allow it, I had a working script when i ran win7, after switching to win10 it didnt work anymore, but after changing some settings in windows it works again.

Look for some permission settings.

Some guy's script + some other guy's script = my script!

Link to comment
Share on other sites

  • 2 weeks later...

Hi Junkew,

thank you for the clue. Unfortunately it is not not loading the Cam. Black screen and the taken snapshot is black as well.

I am so close. I do not know what is causing this. Windows versions that do not have Cam APPs are working Fine.

 

I hope someone from the community here has a workaround

Link to comment
Share on other sites

But I think you are saying its not working for windows 10 but it works for other versions?

Maybe this tells the answer but its not my area of expertise

https://social.msdn.microsoft.com/Forums/vstudio/en-US/f7dacb67-485b-4bb7-b2ff-76c48adce0d6/webcam-vfwh-problem-black-screen?forum=vcgeneral


I tried a little within VBA Excel after some googling but also that gives a black screen

* Create a new Excel 2016+/64 bits VBA form with cmd1,cmd2,cmd3,cmd4 buttons

* Copy / Paste below and run it, you then can see it asks for which webcam but then projecting it into the hwnd keeps giving a black screen.

Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000

Const WM_USER As Long = &H400
Const WM_CAP_START As Long = WM_USER

Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25

Private Declare PtrSafe Function capCreateCaptureWindow _
    Lib "avicap32.dll" Alias "capCreateCaptureWindowA" _
         (ByVal lpszWindowName As String, ByVal dwStyle As Long _
        , ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long _
        , ByVal nHeight As Long, ByVal hwndParent As LongPtr _
        , ByVal nID As Long) As Long

Private Declare PtrSafe Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long _
        , ByVal wParam As Long, ByRef lParam As Any) As Long

Dim hCap As LongPtr
'Dim hCap As Long

Option Explicit
 
#If Win64 Then
 
    Private Declare PtrSafe Function FindWindowA _
        Lib "user32.dll" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
 
    Private mlnghWnd As LongPtr
 
    Public Property Get hWnd() As LongPtr
        hWnd = mlnghWnd
    End Property
 
#Else
 
    Private Declare Function FindWindowA  Lib "user32.dll" ( ByVal lpClassName As String,         ByVal lpWindowName As String) As Long
 
    Private mlnghWnd As Long
 
    Public Property Get hWnd() As Long
        hWnd = mlnghWnd
    End Property
 
#End If
 

 
Private Sub StorehWnd()
 
    Dim strCaption As String
    Dim strClass As String
 
    'class name changed in Office 2000
    If Val(Application.Version) >= 9 Then
        strClass = "ThunderDFrame"
    Else
        strClass = "ThunderXFrame"
    End If
 
    'remember the caption so we can
    'restore it when we're done
    strCaption = Me.Caption
 
    'give the userform a random
    'unique caption so we can reliably
    'get a handle to its window
    Randomize
    Me.Caption = CStr(Rnd)
 
    'store the handle so we can use
    'it for the userform's lifetime
    mlnghWnd = FindWindowA(strClass, Me.Caption)
 
    'set the caption back again
    Me.Caption = strCaption
 
End Sub

Private Sub cmd4_Click()
Dim sFileName As String
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
    sFileName = GetSavePath
    Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(sFileName))
DoFinally:
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
End Sub

Private Sub Cmd3_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
End Sub


Private Sub Cmd1_Click()
    
'    hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.Form.hWnd, 0)
    hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, UserForm1.Width, UserForm1.Height, UserForm1.hWnd, 0)
    If hCap <> 0 Then
        Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If
End Sub

Private Sub Cmd2_Click()
Dim temp As Long
temp = SendMessage(hCap, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
End Sub



Private Sub UserForm_Initialize()
StorehWnd
cmd1.Caption = "Start &Cam"
cmd2.Caption = "&Format Cam"
cmd3.Caption = "&Close Cam"
cmd4.Caption = "&Save Image"
End Sub
Edited by junkew
Link to comment
Share on other sites

This works for me on Win10...(by user "Mylise")

#include <GDIplus.au3>
#Include <GUIConstantsEx.au3>
#include <Constants.au3>

HotKeySet("{ESC}", "_Exit")
;--------------------------------------------------------------------------
; Local variables
Global $Width = 640, $Height = 480, $hGraphics
;--------------------------------------------------------------------------
; variables required for dshow escapi
Local $tagSimpleCapParams = "ptr mTargetBuf;" & "int mWidth;" & "int mHeight;"
Local $tSimpleCapParams = DllStructCreate($tagSimpleCapParams)
Local $tTargetBuf = DllStructCreate("BYTE[" & $Width*$Height*4 & "]")
Global $pTargetBuf = DllStructGetPtr($tTargetBuf)
DllStructSetData($tSimpleCapParams, 1, $pTargetBuf)
DllStructSetData($tSimpleCapParams, 2, $Width)
DllStructSetData($tSimpleCapParams, 3, $Height)
Local $pSimpleCapParams = DllStructGetPtr($tSimpleCapParams)
Local $device = 0 ;change this number to select dshow device

;---------------------------------------------------------------------------
;Escapi init
Global $Gui = GUICreate("EscApi WebCam", $Width, $Height)
GUISetState(@SW_SHOW,$Gui)
_GDIPlus_Startup()
local $_escapi_Dll = DllOpen("escapi.dll")
$return = DllCall($_escapi_Dll,"int","initCOM")
$return = DllCall($_escapi_Dll,"int","countCaptureDevices")
Consolewrite("Number of devices = " & $return[0] & @CRLF)
$return = DllCall($_escapi_Dll,"int:cdecl","initCapture", "int", $device, "ptr", $pSimpleCapParams)
;---------------------------------------------------------------------------
$hGraphics = _GDIPlus_GraphicsCreateFromHWND($Gui)

While 1

;Get frame
DllCall($_escapi_Dll,"none:cdecl","doCapture", "int", $device)
Do
$return = DllCall($_escapi_Dll,"int:cdecl","isCaptureDone", "int", $device)
Until $return[0] = 1

$hBMP = _WinAPI_CreateBitmap($Width, $Height , 1 , 32 , $pTargetBuf)
Local $hImage = _GDIPlus_BitmapCreateFromHBITMAP($hBMP)

_GDIPlus_GraphicsDrawImageRect($hGraphics, $hImage, 0, 0, $Width, $Height)


sleep(10)
_GDIPlus_BitmapDispose($hImage)
_WinAPI_DeleteObject($hBMP)

WEnd

;--------------------------------------------------------------------------
Func _Exit()
   _GDIPlus_GraphicsDispose($hGraphics)
   _GDIPlus_Shutdown()
DllCall($_escapi_Dll,"none:cdecl","deinitCapture", "int", 0)
GUIDelete($Gui)

    Exit
EndFunc

I'm getting an image in the GUI, if it doesnt work for you make sure your windows settings allow webcam access, as mentioned earlier in the thread.

The escapi.dll is attached.

escapi.dll

 

Edited by Werty

Some guy's script + some other guy's script = my script!

Link to comment
Share on other sites

Hi Werty,

Thanks for the code.

How to snap and Save the Image. I don't see how to call escapi.dll for that?

your code launches the Camera but it does not provide function to snap and Save.

I could have done Screenshot using captdll.dll the below code:

local $TimeStamp = @YEAR & @MON & @MDAY & @HOUR & @MIN & @SEC
local $erg

local $sFile = @ScriptDir
$erg = DllCall("captdll.dll", "int:cdecl", "CaptureScreen", "str", $sFile & "\Picture_" & $TimeStamp & ".JPG", "int",75)

But I do not want screen shot because my soft will take the picture while the screen is locked. Any guidance on that from the code you sent ?

 

Many thanks in advance

Edited by mikestern
Link to comment
Share on other sites

It's already "snapping" the image from webcam and showing it in the gui, instead of showing it you could just save it, or do both, whatever.

Here's where you just press "s" on your keyboard, then it saves an image called "test.png" with the current frame.

#include <GDIplus.au3>
#Include <GUIConstantsEx.au3>
#include <Constants.au3>

HotKeySet("{ESC}", "_Exit")
HotKeySet("s", "_SaveImage")
;--------------------------------------------------------------------------
; Local variables
Global $Width = 640, $Height = 480, $hGraphics
;--------------------------------------------------------------------------
; variables required for dshow escapi
Local $tagSimpleCapParams = "ptr mTargetBuf;" & "int mWidth;" & "int mHeight;"
Local $tSimpleCapParams = DllStructCreate($tagSimpleCapParams)
Local $tTargetBuf = DllStructCreate("BYTE[" & $Width*$Height*4 & "]")
Global $pTargetBuf = DllStructGetPtr($tTargetBuf)
DllStructSetData($tSimpleCapParams, 1, $pTargetBuf)
DllStructSetData($tSimpleCapParams, 2, $Width)
DllStructSetData($tSimpleCapParams, 3, $Height)
Local $pSimpleCapParams = DllStructGetPtr($tSimpleCapParams)
Local $device = 0 ;change this number to select dshow device

;---------------------------------------------------------------------------
;Escapi init
Global $Gui = GUICreate("EscApi WebCam", $Width, $Height)
GUISetState(@SW_SHOW,$Gui)
_GDIPlus_Startup()
local $_escapi_Dll = DllOpen("escapi.dll")
$return = DllCall($_escapi_Dll,"int","initCOM")
$return = DllCall($_escapi_Dll,"int","countCaptureDevices")
Consolewrite("Number of devices = " & $return[0] & @CRLF)
$return = DllCall($_escapi_Dll,"int:cdecl","initCapture", "int", $device, "ptr", $pSimpleCapParams)
;---------------------------------------------------------------------------
$hGraphics = _GDIPlus_GraphicsCreateFromHWND($Gui)

While 1

;Get frame
DllCall($_escapi_Dll,"none:cdecl","doCapture", "int", $device)
Do
$return = DllCall($_escapi_Dll,"int:cdecl","isCaptureDone", "int", $device)
Until $return[0] = 1

$hBMP = _WinAPI_CreateBitmap($Width, $Height , 1 , 32 , $pTargetBuf)
Local $hImage = _GDIPlus_BitmapCreateFromHBITMAP($hBMP)

_GDIPlus_GraphicsDrawImageRect($hGraphics, $hImage, 0, 0, $Width, $Height)


sleep(10)
_GDIPlus_BitmapDispose($hImage)
_WinAPI_DeleteObject($hBMP)

WEnd

;--------------------------------------------------------------------------
Func _SaveImage()
   _GDIPlus_ImageSaveToFile($hImage, @ScriptDir & "\test.png")
EndFunc

Func _Exit()
   _GDIPlus_GraphicsDispose($hGraphics)
   _GDIPlus_Shutdown()
DllCall($_escapi_Dll,"none:cdecl","deinitCapture", "int", 0)
GUIDelete($Gui)

    Exit
EndFunc

 

Edited by Werty

Some guy's script + some other guy's script = my script!

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...