Autor
|
Tema: Evitar la seleccion de la camara web (Leído 5,168 veces)
|
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 : 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! 
|
|
|
En línea
|
|
|
|
Lekim
Desconectado
Mensajes: 268
|
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
|
|
|
En línea
|
|
|
|
|
Lekim
Desconectado
Mensajes: 268
|
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
|
|
« Última modificación: 5 Abril 2016, 18:00 pm por Lekim »
|
En línea
|
|
|
|
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! 
|
|
|
En línea
|
|
|
|
Lekim
Desconectado
Mensajes: 268
|
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: 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...
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
|
|
« Última modificación: 7 Abril 2016, 19:27 pm por Lekim »
|
En línea
|
|
|
|
|
|