Al parecer tienes más de un controlador.
Como no tengo más dispositivos no puedo probar lo que te voy a proponer así que ya me contarás.
Este código obtiene una descripción de las versiones de controladores de captura:
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 Sub Form_Load()
Dim strName As String
Dim strVer As String
Dim iReturn As Boolean
Dim X As Long
X = 0
strName = Space(100)
strVer = Space(100)
Do
iReturn = capGetDriverDescriptionA(X, strName, 100, strVer, 100)
If iReturn Then List1.AddItem Trim$(strName)
X = X + 1
Loop Until iReturn = False
End Sub
Obtiene un lista de controladores.
El NOMBRE de la lista del controlador que quieres utilizar es el que se debe establecer en
capCreateCaptureWindowA:
capCreateCaptureWindowA(NOMBRE ,dwStyle, X, Y, nWidth, hWnd nID )
En dwStyle puedes establecer las constantes :
Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000
Si pones List1.List(0), utilizará el primero de la lista.
Tú has puesto "WebcamCapture", quizás este sea el problema.
He realizado este código a partir del que encontré aquí:
Manejo de cámaraEstá muy bien porque no necesitas el Timer y la transición entre imágenes es muy suave. La diferencia con el de la página es que uso el nombre del controlador en lugar de iDevice que es un número, y capCreateCaptureWindowA demanda String y reservo el índice en IndexDevice para el SendMessage. Además puedes guardar imagen de un frame en un instante determinado sin que la captura que se muestra en el Picture se congele.
Necesitas tres botones, un listbox y un Picture, con los nombres:
cmdConectar
cmdDesconectar
cmdGuardar
List1
Picture1
Const WM_CAP As Integer = &H400
Const WM_CAP_DRIVER_CONNECT As Long = 1034
Const WM_CAP_DRIVER_DISCONNECT As Long = 1035
Const WM_CAP_DRIVER_GET_FRAME As Long = 1084
Const WM_CAP_EDIT_COPY As Long = WM_CAP + 30
Const WM_CAP_SET_PREVIEW As Long = WM_CAP + 50
Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP + 52
Const WM_CAP_SET_SCALE As Long = WM_CAP + 53
Const WS_CHILD As Long = &H40000000
Const WS_VISIBLE As Long = &H10000000
Const SWP_NOMOVE As Long = &H2
Const SWP_NOSIZE As Integer = 1
Const SWP_NOZORDER As Integer = &H4
Const HWND_BOTTOM As Integer = 1
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
Private Declare Function SetWindowPos Lib "user32" (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 Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
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 Integer, 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
Dim strDevice As String
Dim IndexDevice As Integer
Dim hHwnd As Long
Private Sub cmdDesconectar_Click()
cmdConectar.Enabled = True
cmdGuardar.Enabled = False
cmdDesconectar.Enabled = False
Desconectar
End Sub
Private Sub cmdGuardar_Click()
On Error GoTo EvitarError:
Dim objPic As IPictureDisp
'//Guarda una imagen de un frame
SendMessage hHwnd, WM_CAP_EDIT_COPY, 0, 0
If Clipboard.GetFormat(vbCFBitmap) Then
Set objPic = Clipboard.GetData(vbCFBitmap)
SavePicture objPic, App.Path & "\ImagenWebCam1.bmp"
End If
EvitarError:
If Err.Number <> 0 Then
MsgBox (Err.Description)
End If
End Sub
Private Sub cmdConectar_Click()
strDevice = List1.List(List1.ListIndex)
IndexDevice = List1.ListIndex
ConectarCamara
End Sub
'//Conecta la cámara
Private Sub ConectarCamara()
'//Activa la webcam
hHwnd = capCreateCaptureWindowA(strDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, Picture1.hwnd, 0)
If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, IndexDevice, 0) Then
SendMessage hHwnd, WM_CAP_SET_SCALE, False, 0
SendMessage hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0
SendMessage hHwnd, WM_CAP_SET_PREVIEW, True, 0
SetWindowPos hHwnd, HWND_BOTTOM, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, _
SWP_NOMOVE Or SWP_NOZORDER
cmdGuardar.Enabled = True
cmdDesconectar.Enabled = True
cmdConectar.Enabled = False
Else
DestroyWindow hHwnd
cmdGuardar.Enabled = False
End If
End Sub
'//Muestra una lista de controladores
Private Sub CargarListaControladores()
Dim strName As String
Dim strVer As String
Dim iReturn As Boolean
Dim x As Long
x = 0
strName = Space(100)
strVer = Space(100)
Do
iReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
If iReturn Then List1.AddItem Trim$(strName)
x = x + 1
Loop Until iReturn = False
End Sub
'//Descanecta la camara
Sub Desconectar()
Dim x As Long
DoEvents
x = SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
x = DestroyWindow(hHwnd)
End Sub
Private Sub Form_Load()
cmdConectar.Caption = "Conectar"
cmdDesconectar.Caption = "Desconectar"
cmdGuardar.Caption = "Guardar frame"
cmdGuardar.Enabled = False
cmdDesconectar.Enabled = False
CargarListaControladores
'Seleciona el primer controlador de la lista
If List1.ListCount > 0 Then
List1.Selected(0) = True
cmdConectar.Enabled = True
Else
cmdConectar.Enabled = False
MsgBox ("No Device Available")
End If
End Sub
El índice del controlador queda guardado en
IndexDevice cuando se selecciona en el ListBox. Se envía un mensaje con este índice y si dicho índice no está en la lista no se activa.
SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, IndexDevice, 0)
Prueba a ir cambiando el controlador de la lista a ver si no te aparece el diálogo.
Una vez me apareció cuando conecté y desconecté rápidamente pero, por mucho que lo he vuelto a hacer no me vuelve a salir. No tengo ni idea de porqué. Si el controlador está siendo usado por otra apliación, el picture aparece de color verde.
s2s