タイトル | : フルHD Webカメラの動画キャプチャ |
記事No | : 16266 |
投稿日 | : 2016/12/13(Tue) 10:19 |
投稿者 | : トル |
はじめまして。
VB6 SP6でフルHD Webカメラの動画をPicture Boxにキャプチャしたいのです。 アドバイス宜しくお願い致します。
下記コードを使わせて頂いております。 フルHD Webカメラを使いますとPicture Boxには何も映らず黒です。 ウィンドウスタイル定数など修正し試しましたがうまくいきません。
環境:Windows7 Pro SP1 32bit
Private Sub Command1_Click() On Error GoTo ErrorHandler
Dim retryCount As Integer Dim tryCount As Integer Dim connectResult As Integer retryCount = 5: tryCount = 0: connectResult = 0
prvVarCaptureHandle = capCreateCaptureWindow("", WS_VISIBLE Or WS_CHILD, 0, 0, Me.Picture1.Width, Me.Picture1.Height, Picture1.hwnd, 0) If prvVarCaptureHandle = 0 Then MsgBox "カメラ接続失敗" Exit Sub End If
Do While tryCount < retryCount connectResult = SendMessageAsLong(prvVarCaptureHandle, WM_CAP_DRIVER_CONNECT, 0, 0) If connectResult <> 0 Then Exit Do End If tryCount = tryCount + 1 Loop Call SendMessageAsLong(prvVarCaptureHandle, WM_CAP_SET_PREVIEWRATE, 10, 0) Call SendMessageAsLong(prvVarCaptureHandle, WM_CAP_SET_PREVIEW, 1, 0)
ErrorHandler: MsgBox ("エラーが発生しました") MsgBox Err.Number & vbCrLf & Err.Source If prvVarCaptureHandle <> 0 Then Call SendMessageAsLong(prvVarCaptureHandle, WM_CAP_DRIVER_DISCONNECT, 0, 0) Call DestroyWindow(prvVarCaptureHandle) prvVarCaptureHandle = 0 End If End Sub
Public prvVarCaptureHandle As Long Public Const WM_USER As Long = &H400 Public Const WM_CAP_START As Long = WM_USER Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10 Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11 Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50 Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52 Public Const WM_CAP_FILE_SAVEDIBA = WM_CAP_START + 25 Public Const WS_CHILD = &H40000000 Public Const WS_VISIBLE = &H10000000 Public Const WM_CAP_SET_OVERLAY As Long = (WM_CAP_START + 51) Public Const WM_CAP_EDIT_COPY As Long = (WM_CAP_START + 30) Public Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean Public 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 Public Declare Function SendMessageAsLong Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Public Declare Function SendMessageAsString Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As String) As Long
|