connection au driver cam directement sans passer par la boite de dialog

[patricktoulon]

Bonjours a tous
mon live cam fonctionne mais je voudrais pouvoir me connecter a la camera sans passer par la boite de dialog périphérique au départ

au démarrage du userform je connecte a la camera avec

SendMessage Hcamera, WM_CAP_DRIVER_CONNECT, 0, 0   'on se connecte a la camera(BOITE DE DIALOG AU DEPART)

mais la première fois ca m'ouvre la boite de dialog pour choisir le scanner ou la camera


je trouve rien sur ce point

si quelqu'un sait ca m'arrangerais
attention je n'utilise pas quarts.filter de directshow (quarts lib)
ou comment memoriser le drivers en long car une fois la première fois faite je peux fermer et ré ouvrir 100 fois le useform la camera est tout de suite reconnue (sans dialog)

code complet de mon userform

'***************************************************************************************
'                      WebCam Preview and Button for  capture in Userform              *
'Version : 4.0                                                                         *
'Date version : 29/07/2018                                                             *
'Autor: patricktoulon alias chamalin2@hotmail.fr sur excel-download et developpez.com  *
'***************************************************************************************
Option Explicit

Private Const WM_CAP As Long = &H400
Private Const WM_CAP_DRIVER_CONNECT As Long = 1034                  ''pour se connecter au periherique
Private Const WM_CAP_DRIVER_DISCONNECT As Long = 1035               'pour se déconnecter au periherique

Private Const WM_CAP_SET_PREVIEW As Long = 1074                     'demarrer le preview
Private Const WM_CAP_SET_PREVIEWRATE As Long = 1076                 'pour le bitrate
Private Const WM_CAP_SET_SCALE As Long = 1077
Private Const WM_CAP_GRAB_FRAME_NOSTOP As Long = 1085               '(rafraichissement constant et non stop )pour pouvoir previsualiser la webcam

Private Const WM_CAP_GRAB_FRAME As Long = 1084                      '(rafraichissement)pour pouvoir previsualiser la webcam

Private Const WM_CAP_FILE_SET_CAPTURE_VIDEO_FILE As Long = 1044     ' alias WM_CAP_FILE_SET_CAPTURE_FILE  pour changer le chemin de destination du fichier AVI
Private Const WM_CAP_SEQUENCE As Long = 1086                      'pour la capture AVI
Private Const WM_CAP_GET_SEQUENCE_SETUP = 1089                      'sais pas
Private Const WM_CAP_SET_SEQUENCE_SETUP = 1088                      'sais pas
Private Const WM_CAP_DLG_VIDEOFORMAT = 1065
Private Const WM_CAP_DLG_VIDEODISPLAY = 1067
Private Const WM_CAP_GET_VIDEOFORMAT = 1068
Private Const WM_CAP_SET_VIDEOFORMAT = 1069
Private Const WM_CAP_DLG_VIDEOCOMPRESSION = 1070

Private Const WM_CAP_COPY_TO_CLIPBOARD As Long = 1054               'pour mettre un instantané dans le clipboard
Private Const WM_CAP_FILE_IMG_SAVEAS As Long = 1049                 'alias "WM_CAP_FILE_SAVEDIB" pour sauver l'image dans un jpg

Private Const WM_CAP_DLG_VIDEOSOURCE As Long = 1066                 'pour afficher les parametre
Private Const WM_CLOSE As Long = &H10                             'pour fermer la camera
Private Const WM_QUIT As Long = &H12
Private Const WM_CAP_STOP As Long = 1092                          'pour arreter le preview

Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_NOCAPTION As Long = &H94080080
Private Const WS_FULLCAPTION As Long = &H94CF0080
Private Const WS_CHILD As Long = &H40000000
Dim Hcamera As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" (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 Long, ByVal nID As Long) As Long
Private Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Long, ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As Boolean
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetParent Lib "User32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SWLG Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SWPOS Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Dim handle_Form&
Dim PtoPX As Double    'converti point to pixel

Private Sub CommandButton2_Click()
    SendMessage Hcamera, WM_CAP_DLG_VIDEOSOURCE, 0, 0    'boite de dialogue parametres de la WebCam
End Sub

Private Sub SnapShot_Click()
    Dim chemin$
    chemin = Environ("userprofile") & "\Desktop\" & IIf(nom_image <> "", nom_image, "Capture") & ".jpg"
    SendMessage Hcamera, WM_CAP_FILE_IMG_SAVEAS, 0&, ByVal CStr(chemin)    'on prend une photo vers un fichier sur le bureau
End Sub


Private Sub UserForm_Activate()
    With SnapShot
        .Picture = CommandBars("Stars & Banners").FindControl(ID:=1183).Picture    'on ajoute un petit icon au bouton qui va bien
        .PicturePosition = 3
    End With
    Me.Tag = Me.InsideWidth & ":" & Me.InsideHeight
    WebCamClip    ' on demarre le bourrin
End Sub


Sub WebCamClip()
    PtoPX = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
    Me.Height = ((Me.Width / 4) * 3) + (70 / PtoPX)
    If Hcamera = 0 Then
        Hcamera = capCreateCaptureWindowA("Live_Preview", WS_NOCAPTION, 0, 0, 400, 300, handle_Form, 0)   'creation de la fentre de preview
        handle_Form = FindWindow(vbNullString, Me.Caption)    'capture du handle de l'userform
        SWLG handle_Form, -16, WS_FULLCAPTION
        If Hcamera <> 0 Then    'si il est capté
            'SWLG Hcamera, -16, WS_NOCAPTION: SWLG Hcamera, -20, &H0:    ' on enleve la caption de la fenetre hcamera
            'DrawMenuBar Hcamera ' on redessine le decalage due a la suppression de la caption
            SetParent Hcamera, handle_Form    'on ' affilie le preview a son nouveau parent (le userform)
            SWPOS Hcamera, 0, 6, 60, (Me.Width * PtoPX) - 20, (((Me.Width * PtoPX) - 40) / 4) * 3, 0    'on positionne le preview correctement dans le userform
            Me.Repaint    'on repaint pour le laps de temps ou il est tout blanc pendant la charge du preview
        End If
       
        'SendMessage Hcamera, WM_CAP_DLG_VIDEODISPLAY, 1, 0   'on se connecte a la camera
        
        SendMessage Hcamera, WM_CAP_DRIVER_CONNECT, 0, 0   'on se connecte a la camera(BOITE DE DIALOG AU DEPART)
        SendMessage Hcamera, WM_CAP_SET_PREVIEW, 1, 0    ' on met le preview a true
       
        '"Hercules Dualpix Infinite"
        SendMessage Hcamera, WM_CAP_SET_PREVIEWRATE, 90, 0    ' on regle le rate (image par secondes)
        SendMessage Hcamera, WM_CAP_SET_SCALE, 1, 0    ' on scale le ratio ou pas
        SendMessage Hcamera, WM_CAP_SET_PREVIEW, 1, 0    ' on met le preview a true
        SendMessage Hcamera, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0    '  on roule le preview (non stop)
    End If
End Sub



'Obligatoire pour fermer la cam
Sub Fermer()
    If Hcamera <> 0 Then
        SendMessage Hcamera, WM_CAP_DRIVER_DISCONNECT, 0, 0    ' on se deconnect de la web cam
        SendMessage Hcamera, WM_CLOSE, 0, 0    ' on ferme la fenetre preview
        SendMessage Hcamera, WM_QUIT, 0, 0    ' on quitte le thread preview
        Hcamera = 0
    End If
End Sub

'on appelle la sub fermer quand on ferme le userform
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer): Fermer: End Sub

Private Sub UserForm_Resize()
    SWPOS Hcamera, 0, 6, 60, (Me.InsideWidth * PtoPX) - 20, (((Me.InsideHeight - (65 / PtoPX)) * PtoPX)), 0    'on positionne le preview correctement dans le userform
End Sub

 

[patricktoulon]

re
mon sujet n’intéresse vraiment personne?
y a t il quelque chose a faire avec capGetDriverDescriptionA et si oui comment?
les rares exemples que j'ai vu sont incohérents dans le sens ou le return ne correspond pas au type d'argument de l'api send message