WEBCAM NO WINDOWS 7

MARCELO.TREZE 09/12/2013 13:47:14
#431925
Galera alguém conseguiu através de algum código fazer funcionar a webcam no windows 7? vejam bem os códigos que existem funcionam muito bem no XP mas não no 7.
SINCLAIR 09/12/2013 15:18:39
#431928 Resposta escolhida
Olá, Marcelo...

Aqui, em certa ocasião a webcam funcionou de boa com VB6 (Windows 7 Home Premium).

Vou me certificar que o código está OK e postar o que eu tiver.
SINCLAIR 09/12/2013 15:21:49
#431929
Marcelo,

Infelizmente no Windows 7 Home Premium não funcionou. No Windows 7 Home Basic funcionou, não sei porque a diferença entre um e outro. Mas, claro, deve ser o elementar: Home Premium 64 bits e Home Basic 32 bits. Deve ser por isto.
MARCELO.TREZE 09/12/2013 18:59:47
#431942
ZEUZÈBIO obrigado por tentar me ajudar, porém consegui depois de muita luta. veja

em um módulo

Public Const ws_child As Long = &H40000000
Public Const ws_visible As Long = &H10000000
Global Const WM_USER = 1024
Global Const wm_cap_driver_connect = WM_USER + 10
Global Const wm_cap_set_preview = WM_USER + 50
Global Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Global Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_USER + 41
Declare Function SendMessage Lib [Ô]user32[Ô] Alias [Ô]SendMessageA[Ô] (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function capCreateCaptureWindow Lib [Ô]avicap32.dll[Ô] Alias [Ô]capCreateCaptureWindowA[Ô] (ByVal a As String, ByVal b As Long, ByVal c As Integer, ByVal d As Integer, ByVal e As Integer, ByVal f As Integer, ByVal g As Long, ByVal h As Integer) As Long


depois coloque o dois botoes no form e altere seus nomes para cmdCapture e cmdClose
coloque um picturebox e deixe o nome como Picture1 mesmo, e cole:

Private Sub cmdCapture_Click()
Dim temp As Long
hwdc = capCreateCaptureWindow([Ô][Ô], ws_child Or ws_visible, 0, 0, 320, 240, Picture1.hWnd, 0)
If (hwdc <> 0) Then
For f = 0 To 2
temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0)
Next f
temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0)
temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0)
startcap = True
Else
MsgBox ([Ô]No Webcam found[Ô])
End If
End Sub


Private Sub cmdClose_Click()
Dim temp As Long
If startcap = True Then
temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
startcap = False
End If
End Sub


O mais legal deste código é que não precisa de timer pra imagem ficar passando
NILSONTRES 10/12/2013 08:47:12
#431947
Puts,
Eu estava precisando disso !

Valeu Marcelo.
Tópico encerrado , respostas não são mais permitidas
Voltar