使用Visual Basic .net 2003 编写摄像头控制程序

以下是我现在编写的程序中的一段代码

可以实现对摄像头摄取视频格式控制

                              多部摄像头同时监控

                        以及一些基本功能

其中WINAPI有较多使用

SO

API过敏者见谅

-----------------------------------------------------------------------------------------------------------------

private sub newcap()'在窗口内建立一个MDI窗口显示摄像头摄取的图像
        Dim lpszName As String
        Dim lpszVer As String
        lpszName = New String(CChar(""), 100)
        lpszVer = New String(CChar(""), 100)
        Dim Caps As CAPDRIVERCAPS

        capGetDriverDescriptionA(0, lpszName, 100, lpszVer, 100)
        lwndC = capCreateCaptureWindowA(lpszName, WS_CAPTION Or WS_THICKFRAME Or WS_VISIBLE Or WS_CHILD, 0, 0, 160, 120, Me.Handle.ToInt32, 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

        SetWindowPos(Me.Handle.ToInt32, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
        capPreview(lwndC, True)
        SetWindowLong(lwndC, GWL_STYLE, WS_THICKFRAME Or WS_CAPTION Or WS_VISIBLE Or WS_CHILD)
End Sub

Module ProSubAndFun

    Public Function capSetCallbackOnErrorO(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
        capSetCallbackOnErrorO = SendMessage(lwnd, WM_CAP_SET_CALLBACK_ERROR, 0, lpProc)
    End Function

    Public Function capSetCallbackOnError(ByVal lwnd As Integer, ByVal lpProc As MyErrorCallbackDelegate) As Boolean
        capSetCallbackOnError = SendMessage(lwnd, WM_CAP_SET_CALLBACK_ERROR, 0, lpProc)
    End Function

    Public Function capSetCallbackOnStatusO(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
        capSetCallbackOnStatusO = SendMessage(lwnd, WM_CAP_SET_CALLBACK_STATUS, 0, lpProc)
    End Function

    Public Function capSetCallbackOnStatus(ByVal lwnd As Integer, ByVal lpProc As MyStatusCallbackDelegate) As Boolean
        capSetCallbackOnStatus = SendMessage(lwnd, WM_CAP_SET_CALLBACK_STATUS, 0, lpProc)
    End Function

    Public Function capSetCallbackOnYield(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
        capSetCallbackOnYield = SendMessage(lwnd, WM_CAP_SET_CALLBACK_YIELD, 0, lpProc)
    End Function

    Public Function capSetCallbackOnFrame(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
        capSetCallbackOnFrame = SendMessage(lwnd, WM_CAP_SET_CALLBACK_FRAME, 0, lpProc)
    End Function

    Public Function capSetCallbackOnVideoStream(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
        capSetCallbackOnVideoStream = SendMessage(lwnd, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, lpProc)
    End Function

    Public Function capSetCallbackOnWaveStream(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
        capSetCallbackOnWaveStream = SendMessage(lwnd, WM_CAP_SET_CALLBACK_WAVESTREAM, 0, lpProc)
    End Function

    Public Function capSetCallbackOnCapControl(ByVal lwnd As Integer, ByVal lpProc As Integer) As Boolean
        capSetCallbackOnCapControl = SendMessage(lwnd, WM_CAP_SET_CALLBACK_CAPCONTROL, 0, lpProc)
    End Function

    Public Function capDriverConnect(ByVal lwnd As Integer, ByVal i As Short) As Boolean
        capDriverConnect = SendMessage(lwnd, WM_CAP_DRIVER_CONNECT, i, 0)
    End Function

    Public Function capDriverGetCaps(ByVal lwnd As Integer, ByVal s As Integer, ByVal wSize As Short) As Boolean
        capDriverGetCaps = SendMessage(lwnd, WM_CAP_DRIVER_GET_CAPS, wSize, s)
    End Function

    Public Function capPreviewScale(ByVal lwnd As Integer, ByVal f As Boolean) As Boolean
        capPreviewScale = SendMessage(lwnd, WM_CAP_SET_SCALE, f, 0)
    End Function

    Public Function capPreview(ByVal lwnd As Integer, ByVal f As Boolean) As Boolean
        capPreview = SendMessage(lwnd, WM_CAP_SET_PREVIEW, f, 0)
    End Function

    Public Function capPreviewRate(ByVal lwnd As Integer, ByVal wMS As Short) As Boolean
        capPreviewRate = SendMessage(lwnd, WM_CAP_SET_PREVIEWRATE, wMS, 0)
    End Function

    Public Function capGetStatus(ByVal lwnd As Integer, ByVal s As Integer, ByVal wSize As Short) As Boolean
        capGetStatus = SendMessage(lwnd, WM_CAP_GET_STATUS, wSize, s)
    End Function

    Public Function capDlgVideoFormat(ByVal lwnd As Integer) As Boolean'调用对话框对视频格式进行调整
        capDlgVideoFormat = SendMessage(lwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0)
    End Function

    Public Function capDlgVideoSource(ByVal lwnd As Integer) As Boolean
        capDlgVideoSource = SendMessage(lwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0)
    End Function

    Public Function capEditCopy(ByVal lwnd As Integer) As Boolean'把当前拍摄到的图像复制到剪切板中
        capEditCopy = SendMessage(lwnd, WM_CAP_EDIT_COPY, 0, 0)
    End Function

    Public Function MyStatusCallback(ByVal lwnd As Integer, ByVal iID As Integer, ByVal ipstrStatusText As Integer)
        If iID = 0 Then Exit Function
        Dim sStatusText As String
        Dim usStatusText As String
        sStatusText = New String(Chr(0), 255)
        lStrCpy(StrPtr(sStatusText), ipstrStatusText)
        sStatusText = Left$(sStatusText, InStr(sStatusText, Chr(0)) - 1)
        usStatusText = StrConv(sStatusText, vbUnicode)
        '      Debug.print("Status:", usStatusText, iID)
    End Function
    Delegate Function MyStatusCallbackDelegate(ByVal lwnd As Integer, ByVal iID As Integer, ByVal ipstrStatusText As Integer)

    Public Function MyErrorCallback(ByVal lwnd As Integer, ByVal iID As Integer, ByVal ipstrStatusText As Integer)
        If iID = 0 Then Exit Function
        Dim sStatusText As String
        Dim usStatusText As String
        sStatusText = New String(Chr(0), 255)
        lStrCpy(StrPtr(sStatusText), ipstrStatusText)
        sStatusText = Left$(sStatusText, vbUnicode)
        'logerror(usStatusText, iID)
    End Function
    Delegate Function MyErrorCallbackDelegate(ByVal lwnd As Integer, ByVal iID As Integer, ByVal ipstrStatusText As Integer)

    Public Sub ResizeCaptureWindow(ByVal lwnd As Integer) '根据摄制的分辨率调整窗口大小，但似乎未发挥作用
        Dim CAPSTATUS As CAPSTATUS
        Dim lCaptionHeight As Integer
        Dim lX_Border As Integer
        Dim lY_Border As Integer
        lCaptionHeight = GetSystemMetrics(SM_CYCAPTION)
        lX_Border = GetSystemMetrics(SM_CXFRAME)
        lY_Border = GetSystemMetrics(SM_CYFRAME)
        If capGetStatus(lwnd, VarPtr(CAPSTATUS), Len(CAPSTATUS)) Then
            SetWindowPos(lwnd, HWND_BOTTOM, 0, 0, CAPSTATUS.uiImageWidth + (lX_Border * 2), CAPSTATUS.uiImageHeight + lCaptionHeight + (lY_Border * 2), SWP_NOMOVE Or SWP_NOZORDER)
        End If
        System.Diagnostics.Debug.WriteLine("Resize Window.")
    End Sub

    Public Function VarPtr(ByVal obj As Object) As Integer
        Dim GC As System.Runtime.InteropServices.GCHandle = System.Runtime.InteropServices.GCHandle.Alloc(obj, Runtime.InteropServices.GCHandleType.Pinned)
        Dim ret As Integer = GC.AddrOfPinnedObject.ToInt32
        GC.Free()
        Return ret
    End Function

    Public Function StrPtr(ByVal str As String) As Integer
        Dim GC As System.Runtime.InteropServices.GCHandle = System.Runtime.InteropServices.GCHandle.Alloc(str, Runtime.InteropServices.GCHandleType.Pinned)
        Dim ret As Integer = GC.AddrOfPinnedObject.ToInt32
        GC.Free()
        Return ret
    End Function
End Module
-----------------------------------------------------------------------------------------------------------------------------------------------

主要功能都在Module ProSubAndFun中

还有很多传统功能，嘻，自己看吧