ビデオデータをキャプチャするには？ (ID：81745)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

まず・・・
capFileSaveAs でのファイルセーブは、もう随分昔のことで
現在、なぜできないのかサッパリ・・・
こちらでも確認しましたが、できませんでした。
何かおまじないが必要かも・・・

で、やはりクリップボード経由でキャプチャした画像をファイル
に保存するやり方で、動作確認できました。

それと懸案の・・・PreView中に、ボタンをクリックしたら、
キャピチャ画像を保存し、画面はそのまま継続してPreViewする
と言う部分ですが・・・

以下、ソース・・・

Option Explicit

Private Const WS_CHILD As Long = &H40000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const SWP_NOMOVE As Integer = &H2
Private Const SWP_NOSIZE As Integer = 1
Private Const SWP_NOZORDER As Integer = &H4
Private Const HWND_BOTTOM As Integer = 1

Private Const WM_USER As Long = &H400
Private Const WM_CAP_START As Long = WM_USER
Private Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Private Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Private Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Private Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Private Const WM_CAP_SET_SCALE As Long = WM_CAP_START + 53
Private Const WM_CAP_EDIT_COPY As Long = WM_CAP_START + 30

Private iDevice As Long
Private hHwnd 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 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 'returns HWND

Private Declare Function capGetDriverDescription Lib "avicap32.dll" Alias "capGetDriverDescriptionA" _
                                        (ByVal dwDriverIndex As Long, _
                                        ByVal lpszName As String, _
                                        ByVal cbName As Long, _
                                        ByVal lpszVer As String, _
                                        ByVal cbVer As Long) As Long 'returns C BOOL

Private 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

Private Sub Form_Load()

Call LoadDeviceList
    
    If List1.ListCount > 0 Then
        Command1.Enabled = True
        List1.ListIndex = 0
    Else
        List1.AddItem ("No Video Capture Device Found")
        Command1.Enabled = False
    End If
    
    Command2.Enabled = False
    Command3.Enabled = False
    
End Sub

Private Sub LoadDeviceList()

Dim strName As String
    Dim strVer As String
    Dim bReturn As Boolean
    Dim x As Integer
    
    strName = Space(100)
    strVer = Space(100)
    x = 0
            
    Do
        bReturn = capGetDriverDescription(x, strName, 100, strVer, 100)
        If bReturn Then
            List1.AddItem (Trim(strName))
        End If
        x = x + 1
    Loop Until bReturn = False
    
End Sub

Private Sub OpenPreviewWindow()

Dim iHeight As Long
    Dim iWidth As Long
    
    iHeight = Picture1.Height / 16
    iWidth = Picture1.Width / 16
    
    hHwnd = capCreateCaptureWindow(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 320, 240, Picture1.hWnd, 0)
    
    If capDriverConnect(hHwnd, iDevice) Then
        Call capPreviewScale(hHwnd, True)
        Call capPreviewRate(hHwnd, 66)
        Call capPreview(hHwnd, True)
        Call SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, iWidth, iHeight, SWP_NOMOVE Or SWP_NOZORDER)
        
        Command1.Enabled = False
        Command2.Enabled = True
        Command3.Enabled = True
    Else
        DestroyWindow (hHwnd)
    End If

End Sub

Private Sub ClosePreviewWindow()
        
    Call capDriverDisconnect(hHwnd, iDevice)
    Call DestroyWindow(hHwnd)

End Sub

Private Sub Command1_Click()
        
    iDevice = List1.ListIndex
    Call OpenPreviewWindow
    
End Sub

Private Sub Command2_Click()

Call ClosePreviewWindow
    
    Command1.Enabled = True
    Command2.Enabled = False
    Command3.Enabled = False
    
End Sub

Private Sub Command3_Click()

Dim bRet As Boolean
    Dim szTest As String

szTest = App.Path & "\TEST.bmp" & Chr$(0)

bRet = capEditCopy(hHwnd)
    If bRet Then
        DoEvents
        If Clipboard.GetFormat(vbCFBitmap) Then
            Picture1.Picture = Clipboard.GetData(vbCFBitmap)
            SavePicture Picture1.Image, szTest
            DoEvents
            Clipboard.Clear
        End If
    End If

End Sub

Private Sub Command4_Click()

Call ClosePreviewWindow

Me.Hide
    Unload Me
    
    End
    
End Sub

Private Function capDriverConnect(ByVal hCapWnd As Long, Optional ByVal i As Long = 0&) As Boolean

capDriverConnect = SendMessageAsLong(hCapWnd, WM_CAP_DRIVER_CONNECT, i, 0&)
   
End Function

Private Function capDriverDisconnect(ByVal hCapWnd As Long, Optional ByVal i As Long = 0&) As Boolean

capDriverDisconnect = SendMessageAsLong(hCapWnd, WM_CAP_DRIVER_DISCONNECT, i, 0&)
   
End Function

Private Function capPreview(ByVal hCapWnd As Long, ByVal f As Boolean) As Boolean

capPreview = SendMessageAsLong(hCapWnd, WM_CAP_SET_PREVIEW, -(f), 0&) 'convert the VB Boolean to a C BOOL with the - sign
   
End Function

Private Function capPreviewRate(ByVal hCapWnd As Long, ByVal wMS As Long) As Boolean

capPreviewRate = SendMessageAsLong(hCapWnd, WM_CAP_SET_PREVIEWRATE, wMS, 0&)
   
End Function

Private Function capPreviewScale(ByVal hCapWnd As Long, ByVal f As Boolean) As Boolean

capPreviewScale = SendMessageAsLong(hCapWnd, WM_CAP_SET_SCALE, -(f), 0&)
   
End Function

Private Function capEditCopy(ByVal hCapWnd As Long) As Boolean

capEditCopy = SendMessageAsLong(hCapWnd, WM_CAP_EDIT_COPY, 0&, 0&)
   
End Function

←解決時は質問者本人がここをチェックしてください。

戻る