galera vcs sempre me ajudarao vai ai mais uma duvida
uso esse codigo pra ver a web cam num formulario mas nao consigo tirar a foto e salvar no hd ja tenten tudo
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 ReleaseCapture Lib "user32" () As Long
Private Const wm_cap_driver_connect As Long = 1034
Private Const WM_CAP_DRIVER_DISCONNECT As Long = 1035
Private Const WM_CAP_GRAB_FRAME As Long = 1084
Private Const WM_CAP_EDIT_COPY As Long = 1054
Private Const WM_CAP_DLG_VIDEOFORMAT As Long = 1065
Private Const WM_CAP_DLG_VIDEOSOURCE As Long = 1066
Private Const WM_CLOSE = &H10
Private mCapHwnd As Long
esse nao funciona da erro fala que clipboard nao definido pelo usuario
Private Sub CAPTURAR_Click()
''Captura a imagem atual, se você quiser pode colocar esse cod num Timer para capturar continuamente....
Clipboard.Clear
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0
Picture1.Picture = Clipboard.GetData
End Sub
-----------------------------------------------------------------------------------------------------------------------------
esse aqui funciona ele faz a web cam aparecer no formulario assim que carrega
Private Sub Form_Load()
Dim lpszName As String * 100
Dim lpszVer As String * 100
Dim Caps As CAPDRIVERCAPS
mCapHwnd = capCreateCaptureWindow("My Own Capture Window", 0, 0, 0, 320, 240, Me.hWnd, 0)
SendMessage mCapHwnd, wm_cap_driver_connect, 0, 0
capGetDriverDescriptionA 0, lpszName, 50, lpszVer, 50
lwndC = capCreateCaptureWindowa(lpszName, WS_CAPTION Or WS_THICKFRAME Or ws_visible Or ws_child, 0, 0, 160, 120, Me.hWnd, 0)
SetWindowText lwndC, lpszName
capSetCallbackOnStatus lwndC, AddressOf MyStatusCallback
capSetCallbackOnError lwndC, AddressOf MyErrorCallback
If capDriverConnect(lwndC, 0) Then
capDriverGetCaps lwndC, VarPtr(Caps), Len(Caps)
capPreviewScale lwndC, True
capPreviewRate lwndC, 66
capPreview lwndC, True
ResizeCaptureWindow lwndC
End If
If SendMessage(mCapHwnd, wm_cap_driver_connect, 0, 0) = 0 Then
MsgBox ("Não foi detectada nenhuma WebCam"), vbInformation, "Rio Corais"
End If
End Sub
esse encerra a cam assim que fecha o formulario esse tambem funciona.
Private Sub Form_Close()
SendMessage mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
DestroyWindow (mCapHwnd)
End Sub
uso esse codigo pra ver a web cam num formulario mas nao consigo tirar a foto e salvar no hd ja tenten tudo
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 ReleaseCapture Lib "user32" () As Long
Private Const wm_cap_driver_connect As Long = 1034
Private Const WM_CAP_DRIVER_DISCONNECT As Long = 1035
Private Const WM_CAP_GRAB_FRAME As Long = 1084
Private Const WM_CAP_EDIT_COPY As Long = 1054
Private Const WM_CAP_DLG_VIDEOFORMAT As Long = 1065
Private Const WM_CAP_DLG_VIDEOSOURCE As Long = 1066
Private Const WM_CLOSE = &H10
Private mCapHwnd As Long
esse nao funciona da erro fala que clipboard nao definido pelo usuario
Private Sub CAPTURAR_Click()
''Captura a imagem atual, se você quiser pode colocar esse cod num Timer para capturar continuamente....
Clipboard.Clear
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0
Picture1.Picture = Clipboard.GetData
End Sub
-----------------------------------------------------------------------------------------------------------------------------
esse aqui funciona ele faz a web cam aparecer no formulario assim que carrega
Private Sub Form_Load()
Dim lpszName As String * 100
Dim lpszVer As String * 100
Dim Caps As CAPDRIVERCAPS
mCapHwnd = capCreateCaptureWindow("My Own Capture Window", 0, 0, 0, 320, 240, Me.hWnd, 0)
SendMessage mCapHwnd, wm_cap_driver_connect, 0, 0
capGetDriverDescriptionA 0, lpszName, 50, lpszVer, 50
lwndC = capCreateCaptureWindowa(lpszName, WS_CAPTION Or WS_THICKFRAME Or ws_visible Or ws_child, 0, 0, 160, 120, Me.hWnd, 0)
SetWindowText lwndC, lpszName
capSetCallbackOnStatus lwndC, AddressOf MyStatusCallback
capSetCallbackOnError lwndC, AddressOf MyErrorCallback
If capDriverConnect(lwndC, 0) Then
capDriverGetCaps lwndC, VarPtr(Caps), Len(Caps)
capPreviewScale lwndC, True
capPreviewRate lwndC, 66
capPreview lwndC, True
ResizeCaptureWindow lwndC
End If
If SendMessage(mCapHwnd, wm_cap_driver_connect, 0, 0) = 0 Then
MsgBox ("Não foi detectada nenhuma WebCam"), vbInformation, "Rio Corais"
End If
End Sub
esse encerra a cam assim que fecha o formulario esse tambem funciona.
Private Sub Form_Close()
SendMessage mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
DestroyWindow (mCapHwnd)
End Sub