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 :
SendMessage mCapHwnd, 1034, 0, 0
El codigo solo necesita un picturebos y un timer para que lo prueben.
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! ;)
Hola
He probado tu código y a mi no me aparece ningún diálogo.
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
(http://oi68.tinypic.com/x60imf.jpg)
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ámara (http://www.lawebdelprogramador.com/foros/Visual-Basic/450585-MANEJO-DE-CAMARA-WEB-POR-VB6.html)
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
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
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?.
(http://es.zimagez.com/miniature/captura455.png) (http://es.zimagez.com/zimage/captura455.php)
Un saludo y muchas gracias igual sigo revisando el codigo! ;-)
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 :P.
Una solución podría ser crear una espera entre un proceso y el otro
Por ejemplo:
Do
hHwnd = capCreateCaptureWindowA(strDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, Picture1.hwnd, 0)
DoEvents
Loop While hwnd = 0
O mejor:
'//...
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 (http://stackoverflow.com/questions/10721085/webcam-video-source-dialog-comes-up)
...
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