Evitar la seleccion de la camara web

[illuminat3d]

Es un codigo sencillo, es para capturar la camara web, lo que quiero saber es como evitar que salga el dialogo para seleccionar el source de la camara, obtenerlo por otro medio el source y seleccionarlo de una forma diferente, la linea que muestra el dialogo es la siguiente :

Código (vb) [Seleccionar] Expandir

SendMessage mCapHwnd, 1034, 0, 0

El codigo solo necesita un picturebos y un timer para que lo prueben.

Código (vb) [Seleccionar] Expandir


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 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 Long, ByVal nID As Long) As Long

Private mCapHwnd As Long
Private Sub Form_Load()
STARTCAM
End Sub

Private Sub Timer1_Timer()
SendMessage mCapHwnd, 1084, 0, 0
SendMessage mCapHwnd, 1054, 0, 0
Picture1.Picture = Clipboard.GetData
End Sub

Sub STARTCAM()
mCapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hwnd, 0)
'DoEvents
SendMessage mCapHwnd, 1034, 0, 0
End Sub



Un saludo y espero algunas ideas!

[Lekim]

Hola

He probado tu código y a mi no me aparece ningún diálogo.

Código (vb) [Seleccionar] Expandir



Private Declare 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 Long, _
    ByVal nID As Long) 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
 
Private Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean

Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private Const GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Private hWndCap As Long
'//Activar Cámara web
Private Sub Command1_Click()
Conectar
Timer1.Enabled = True
End Sub
'//Desconecta la cámara web
Private Sub Command2_Click()
Dim ClearImage As IPictureDisp
Desconectar
Timer1.Enabled = False
Picture1.Refresh
Picture1.Picture = ClearImage
End Sub

Public Sub CapturarCamara()
Dim x As Long
Picture1.Refresh
x = SendMessage(hWndCap, GET_FRAME, 0, 0)
x = SendMessage(hWndCap, COPY, 0, 0)
Picture1.Picture = Clipboard.GetData
End Sub
Sub Conectar()
   Dim x As Long
    hWndCap = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hwnd, 0)
    DoEvents
    x = SendMessage(hWndCap, CONNECT, 0, 0)

End Sub
Sub Desconectar()
Dim x As Long
    DoEvents
    x = SendMessage(hWndCap, DISCONNECT, 0, 0)
    x = DestroyWindow(hWndCap)
End Sub

Private Sub Form_Load()
Timer1.Interval = 1
Timer1.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Dim x As Long
   Desconectar
    x = DestroyWindow(hWndCap)
End Sub

Private Sub Timer1_Timer()
CapturarCamara
End Sub




[illuminat3d]

[Lekim]

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:

Código (vb) [Seleccionar] Expandir

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:

Código [Seleccionar] Expandir

capCreateCaptureWindowA(NOMBRE ,dwStyle, X, Y, nWidth, hWnd nID                 )

En dwStyle puedes establecer las constantes :

Código (vb) [Seleccionar] Expandir

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ámara

Está 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

Código (vb) [Seleccionar] Expandir



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.

Código [Seleccionar] Expandir

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

[illuminat3d]

Gracias Lekim por tomarte la molestia lo primero que todo, es cierto que sin un timer la muestra de imagenes es mas fluida, lo que no veo eso el principal problema, ten en cuenta que para que no envie tantas capturas al cliente. Esta muy bien tu codigo el unico problema es que seguimos sin conseguir el resultado, porque la api capGetDriverDescriptionA obtiene una descripcion pero no el nombre del dispositivo de video, ¿tu crees que poniendo el nombre del dispositivo de video en lugar de "WebCamCapture" seleccionaria directamente el controlador ese sin necesidad de seleccionarlo?.



Un saludo y muchas gracias igual sigo revisando el codigo! 

[Lekim]

Mi teoría es que  la función llama a capCreateCaptureWindowA para obtener el handle (hwnd) y posteriormente se manda el mensaje para conectar pero el paso de uno al otro es demasiado rápido, casi simultáneo y se intenta conectar ANTES de haber recibido el handle o preparar el dispositivo, yo que se  .

Una solución podría ser crear una espera entre un proceso y el otro

Por ejemplo:

Código (vb) [Seleccionar] Expandir

Do
hHwnd = capCreateCaptureWindowA(strDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, Picture1.hwnd, 0)
DoEvents
Loop While hwnd = 0

O mejor:

Código (vb) [Seleccionar] Expandir



'//...
Private Sub Espera(Segundos As Single)
 Dim ComienzoSeg As Single
 Dim FinSeg As Single
 ComienzoSeg = Timer
 FinSeg = ComienzoSeg + Segundos
 Do While FinSeg > Timer
     DoEvents
     If ComienzoSeg > Timer Then
         FinSeg = FinSeg - 24 * 60 * 60
     End If
 Loop
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)

Espera (2) '///<---Esperar dos segundos antes de conectar

Dim Retry As Boolean, I As Integer

For I = 1 To 10 '//Hace diez intentos para conectar
Retry = SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, IndexDevice, 0)

   If Retry = True 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
       Exit For
   End If
Next I

If Retry = False Then
       DestroyWindow hHwnd
       cmdGuardar.Enabled = False
End If

End Sub


'//...






Me he basado en las respuestas de este otro usuario que tenía el mismo problema:

http://stackoverflow.com/questions/10721085/webcam-video-source-dialog-comes-up

Código [Seleccionar] Expandir


...

2
down vote
Finally I Found a solution for this.
The problem happens in Windows 7 / 8

First you need this API function

Private Declare Function GetTickCount Lib "kernel32" () As Long
Then... after you call capCreateCaptureWindowA() you have to wait 1 second processing events, (note: sleep don't work the same)

IniTime = GetTickCount()
While GetTickCount() < (IniTime + 1000)
  DoEvents
Wend
then you call WM_CAP_DRIVER_CONNECT (maybe a couple of times).. and THAT's IT ... no more video source dialog

'...

With this solution it works perfect. The GetTickCount() waiting for events worked along with calling the function until it returned true.

Private Sub PreviewVideo(ByVal pbCtrl As PictureBox)    
   hWnd = capCreateCaptureWindowA(VideoSource, WS_VISIBLE Or WS_CHILD, 0, 0, 0,
  0, pbCtrl.Handle.ToInt64, 0)    
   Dim IniTime As Long = GetTickCount()
   While GetTickCount() < (IniTime + 1000)
       Application.DoEvents()
   End While    
   Dim OKAnswer As Boolean = False
   For xretries As Integer = 1 To 10
         ' I'll give you Only 10 tries to connect, otherwise I AM LEAVING MICROSOFT!
         OKAnswer = SendMessage(hWnd, WM_CAP_DRIVER_CONNECT, VideoSource, 0)
         If OKAnswer Then
             Exit For
         End If    
   Next    
   If okanswer Then
         SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0)
         SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0)
         SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0)
         SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, pbCtrl.Width, pbCtrl.Height, SWP_NOMOVE Or SWP_NOZORDER)    
   Else
         DestroyWindow(hWnd)    
   End If    
End Sub


Claro que esto es en Net