読者です 読者をやめる 読者になる 読者になる

俺の備忘録

個人的な備忘録です。

VB.NETでノート内臓カメラをキャプチャ

VB

作ったもの

  • ノートPCの内臓カメラをキャプチャ(プレビュー)
  • Enterキーを押すとキャプチャ画像を保存
  • VB.NETで作成

f:id:magayengineer:20160614225940p:plain

コード

Public Class Form1

    'Windows API
    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_FILE_SAVEDIBA = WM_CAP_START + 25
    Private Const WS_CHILD = &H40000000
    Private Const WS_VISIBLE = &H10000000

    Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal lpszWindowName As String, ByVal dwStyle As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Short, ByVal hWndParent As Integer, ByVal nID As Integer) As Integer
    Private Declare Function sendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As String) As Integer
    Private Declare Function destroyWindow Lib "user32" Alias "DestroyWindow" (ByVal hndw As Integer) As Boolean
    Private Declare Function getTickCount Lib "kernel32" Alias "GetTickCount" () As Long


    'キャプチャ画面のハンドル
    Private cHandle As Long = -1

    'Formのロードイベント
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'サイズ固定化
        Me.FormBorderStyle = FormBorderStyle.FixedSingle
        Me.MaximumSize = Me.Size
        Me.MinimumSize = Me.Size

        'キャプチャウィンドウ作成
        cHandle = capCreateCaptureWindow("", WS_VISIBLE Or WS_CHILD, 0, 0, Me.Width, Me.Height, Me.Handle, 0)
        If cHandle = -1 Then
            MessageBox.Show("capCreateCaptureWindow failed.")
            Exit Sub
        End If

        'カメラが準備できるまで少し待つ(必要があるらしい)
        Dim IniTime = getTickCount()
        While getTickCount() < (IniTime + 1000)
            Application.DoEvents()
        End While

        'リトライ回数
        Dim retryCount As Integer = 5
        Dim tryCount As Integer = 0
        Dim connectResult As Integer = 0

        '成功するまでカメラ接続を試行する(タイミングにより失敗することが多々ある.特にWin8.1)
        While tryCount < retryCount
            '注意:カメラが複数ある場合は第3引数を変える
            connectResult = sendMessage(cHandle, WM_CAP_DRIVER_CONNECT, 0, 0)
            If connectResult <> 0 Then
                Exit While
            End If
            tryCount += 1
        End While

        'カメラに接続失敗
        If connectResult = 0 Then
            Call destroyWindow(cHandle)
            cHandle = -1
            MessageBox.Show("WM_CAP_DRIVER_CONNECT failed.")
            Exit Sub
        End If

        Call sendMessage(cHandle, WM_CAP_SET_PREVIEWRATE, 60, 0) ' frame rateっぽい
        Call sendMessage(cHandle, WM_CAP_SET_PREVIEW, 1, 0)
    End Sub

    'Formのクローズイベント
    Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed
        If cHandle > -1 Then
            Call sendMessage(cHandle, WM_CAP_DRIVER_DISCONNECT, 0, 0)
            Call destroyWindow(cHandle)
            cHandle = -1
        End If
    End Sub

    '画面キャプチャ保存
    Private Sub From1_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles Me.KeyDown
        If e.KeyData = Keys.Enter Then
            If cHandle > -1 Then
                'Bitmapで一度保存
                Dim dateStr = DateTime.Now.ToString("yyyyMMdd_HHmmss")
                Dim bmpFile = dateStr + ".bmp"
                Call sendMessage(cHandle, WM_CAP_FILE_SAVEDIBA, 0, bmpFile)

                'PNGn変換
                Dim bmpData As New System.Drawing.Bitmap(bmpFile)
                bmpData.Save(dateStr + ".png", System.Drawing.Imaging.ImageFormat.Png)
                bmpData.Dispose()

                'Bitmap削除
                System.IO.File.Delete(bmpFile)
            End If
        End If
    End Sub
End Class

参考サイト

http://i-break.net/article/69427813.html https://msdn.microsoft.com/en-us/library/windows/desktop/dd757695(v=vs.85).aspx http://www.ecoop.net/coop/api/winmes.html https://social.msdn.microsoft.com/Forums/vstudio/en-US/6d2d2e0f-cab7-4299-a778-cb8d9bab4b0d/avicap32dll-wmcapdriverconnect-problem?forum=csharpgeneral