摄像头公用类:Option Explicit'*
'* Author: E. J. Bantz Jr.
'* Copyright: None, use and distribute freely ...
'* E-Mail: [email protected]
'* Web: http://www.inlink.com/~ejbantz'// ------------------------------------------------------------------
'//  Windows API Constants / Types / Declarations
'// ------------------------------------------------------------------
Private Const HWND_BOTTOM = 1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const WS_BORDER = &H800000
Private Const WS_CAPTION = &HC00000
Private Const WS_SYSMENU = &H80000
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_OVERLAPPED = &H0&
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_THICKFRAME = &H40000
Private Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Private Const SM_CYCAPTION = 4
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33
Private Const WS_EX_TRANSPARENT = &H20&
Private Const GWL_STYLE = (-16)Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'// Memory manipulation
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function lStrCpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As Any, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal hpvDest As Long, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub hmemcpy Lib "kernel32" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
    
'// Window manipulation
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 GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
''===========================================
''纯视频捕获定义''第一部分 结构定义
Private Type POINTAPI
        x As Long
        y As Long
End TypePrivate Type CAPDRIVERCAPS
    wDeviceIndex As Long '               // Driver index in system.ini
    fHasOverlay As Long '                // Can device overlay?
    fHasDlgVideoSource As Long '         // Has Video source dlg?
    fHasDlgVideoFormat As Long '         // Has Format dlg?
    fHasDlgVideoDisplay As Long '        // Has External out dlg?
    fCaptureInitialized As Long '        // Driver ready to capture?
    fDriverSuppliesPalettes As Long '    // Can driver make palettes?
    hVideoIn As Long '                   // Driver In channel
    hVideoOut As Long '                  // Driver Out channel
    hVideoExtIn As Long '                // Driver Ext In channel
    hVideoExtOut As Long '               // Driver Ext Out channel
End TypePrivate Type CAPSTATUS
    uiImageWidth As Long                    '// Width of the image
    uiImageHeight As Long                   '// Height of the image
    fLiveWindow As Long                     '// Now Previewing video?
    fOverlayWindow As Long                  '// Now Overlaying video?
    fScale As Long                          '// Scale image to client?
    ptScroll As POINTAPI                    '// Scroll position
    fUsingDefaultPalette As Long            '// Using default driver palette?
    fAudioHardware As Long                  '// Audio hardware present?
    fCapFileExists As Long                  '// Does capture file exist?
    dwCurrentVideoFrame As Long             '// # of video frames cap'td
    dwCurrentVideoFramesDropped As Long     '// # of video frames dropped
    dwCurrentWaveSamples As Long            '// # of wave samples cap'td
    dwCurrentTimeElapsedMS As Long          '// Elapsed capture duration
    hPalCurrent As Long                     '// Current palette in use
    fCapturingNow As Long                   '// Capture in progress?
    dwReturn As Long                        '// Error value after any operation
    wNumVideoAllocated As Long              '// Actual number of video buffers
    wNumAudioAllocated As Long              '// Actual number of audio buffers
End TypePrivate Type CAPTUREPARMS
    dwRequestMicroSecPerFrame As Long       '// Requested capture rate
    fMakeUserHitOKToCapture As Long         '// Show "Hit OK to cap" dlg?
    wPercentDropForError As Long            '// Give error msg if > (10%)
    fYield As Long                          '// Capture via background task?
    dwIndexSize As Long                     '// Max index size in frames (32K)
    wChunkGranularity As Long               '// Junk chunk granularity (2K)
    fUsingDOSMemory As Long                 '// Use DOS buffers?
    wNumVideoRequested As Long              '// # video buffers, If 0, autocalc
    fCaptureAudio As Long                   '// Capture audio?
    wNumAudioRequested As Long              '// # audio buffers, If 0, autocalc
    vKeyAbort As Long                       '// Virtual key causing abort
    fAbortLeftMouse As Long                 '// Abort on left mouse?
    fAbortRightMouse As Long                '// Abort on right mouse?
    fLimitEnabled As Long                   '// Use wTimeLimit?
    wTimeLimit As Long                      '// Seconds to capture
    fMCIControl As Long                     '// Use MCI video source?
    fStepMCIDevice As Long                  '// Step MCI device?
    dwMCIStartTime As Long                  '// Time to start in MS
    dwMCIStopTime As Long                   '// Time to stop in MS
    fStepCaptureAt2x As Long                '// Perform spatial averaging 2x
    wStepCaptureAverageFrames As Long       '// Temporal average n Frames
    dwAudioBufferSize As Long               '// Size of audio bufs (0 = default)
    fDisableWriteCache As Long              '// Attempt to disable write cache
End TypePrivate Type CAPINFOCHUNK
    fccInfoID As Long                       '// Chunk ID, "ICOP" for copyright
    lpData As Long                          '// pointer to data
    cbData As Long                          '// size of lpData
End TypePrivate Type VIDEOHDR
    lpData As Long                          '// address of video buffer
    dwBufferLength As Long                  '// size, in bytes, of the Data buffer
    dwBytesUsed As Long                     '// see below
    dwTimeCaptured As Long                  '// see below
    dwUser As Long                          '// user-specific data
    dwFlags As Long                         '// see below
    dwReserved(3) As Long                   '// reserved; do not use}
End Type

解决方案 »

  1.   

    ''第二部分 常量定义
    Private Const WM_USER = &H400
    '// Defines start of the message range
    Private Const WM_CAP_START = WM_USERPrivate Const WM_CAP_GET_CAPSTREAMPTR = WM_CAP_START + 1Private Const WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2
    Private Const WM_CAP_SET_CALLBACK_STATUS = WM_CAP_START + 3
    Private Const WM_CAP_SET_CALLBACK_YIELD = WM_CAP_START + 4
    Private Const WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5
    Private Const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6
    Private Const WM_CAP_SET_CALLBACK_WAVESTREAM = WM_CAP_START + 7
    Private Const WM_CAP_GET_USER_DATA = WM_CAP_START + 8
    Private Const WM_CAP_SET_USER_DATA = WM_CAP_START + 9
        
    Private Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10
    Private Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11
    Private Const WM_CAP_DRIVER_GET_NAME = WM_CAP_START + 12
    Private Const WM_CAP_DRIVER_GET_VERSION = WM_CAP_START + 13
    Private Const WM_CAP_DRIVER_GET_CAPS = WM_CAP_START + 14Private Const WM_CAP_FILE_SET_CAPTURE_FILE = WM_CAP_START + 20
    Private Const WM_CAP_FILE_GET_CAPTURE_FILE = WM_CAP_START + 21
    Private Const WM_CAP_FILE_ALLOCATE = WM_CAP_START + 22
    Private Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23
    Private Const WM_CAP_FILE_SET_INFOCHUNK = WM_CAP_START + 24
    Private Const WM_CAP_FILE_SAVEDIB = WM_CAP_START + 25Private Const WM_CAP_EDIT_COPY = WM_CAP_START + 30Private Const WM_CAP_SET_AUDIOFORMAT = WM_CAP_START + 35
    Private Const WM_CAP_GET_AUDIOFORMAT = WM_CAP_START + 36Private Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41
    Private Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42
    Private Const WM_CAP_DLG_VIDEODISPLAY = WM_CAP_START + 43
    Private Const WM_CAP_GET_VIDEOFORMAT = WM_CAP_START + 44
    Private Const WM_CAP_SET_VIDEOFORMAT = WM_CAP_START + 45
    Private Const WM_CAP_DLG_VIDEOCOMPRESSION = WM_CAP_START + 46Private Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50
    Private Const WM_CAP_SET_OVERLAY = WM_CAP_START + 51
    Private Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52
    Private Const WM_CAP_SET_SCALE = WM_CAP_START + 53
    Private Const WM_CAP_GET_STATUS = WM_CAP_START + 54
    Private Const WM_CAP_SET_SCROLL = WM_CAP_START + 55Private Const WM_CAP_GRAB_FRAME = WM_CAP_START + 60
    Private Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP_START + 61Private Const WM_CAP_SEQUENCE = WM_CAP_START + 62
    Private Const WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63
    Private Const WM_CAP_SET_SEQUENCE_SETUP = WM_CAP_START + 64
    Private Const WM_CAP_GET_SEQUENCE_SETUP = WM_CAP_START + 65
    Private Const WM_CAP_SET_MCI_DEVICE = WM_CAP_START + 66
    Private Const WM_CAP_GET_MCI_DEVICE = WM_CAP_START + 67
    Private Const WM_CAP_STOP = WM_CAP_START + 68
    Private Const WM_CAP_ABORT = WM_CAP_START + 69Private Const WM_CAP_SINGLE_FRAME_OPEN = WM_CAP_START + 70
    Private Const WM_CAP_SINGLE_FRAME_CLOSE = WM_CAP_START + 71
    Private Const WM_CAP_SINGLE_FRAME = WM_CAP_START + 72Private Const WM_CAP_PAL_OPEN = WM_CAP_START + 80
    Private Const WM_CAP_PAL_SAVE = WM_CAP_START + 81
    Private Const WM_CAP_PAL_PASTE = WM_CAP_START + 82
    Private Const WM_CAP_PAL_AUTOCREATE = WM_CAP_START + 83
    Private Const WM_CAP_PAL_MANUALCREATE = WM_CAP_START + 84'// Following added post VFW 1.1
    Private Const WM_CAP_SET_CALLBACK_CAPCONTROL = WM_CAP_START + 85'// Defines end of the message range
    Private Const WM_CAP_END = WM_CAP_SET_CALLBACK_CAPCONTROL'// String IDs from status and error callbacks
    '// ------------------------------------------------------------------Private Const IDS_CAP_BEGIN = 300              '/* "Capture Start" */
    Private Const IDS_CAP_END = 301                '/* "Capture End" */Private Const IDS_CAP_INFO = 401               '/* "%s" */
    Private Const IDS_CAP_OUTOFMEM = 402           '/* "Out of memory" */
    Private Const IDS_CAP_FILEEXISTS = 403         '/* "File '%s' exists -- overwrite it?" */
    Private Const IDS_CAP_ERRORPALOPEN = 404       '/* "Error opening palette '%s'" */
    Private Const IDS_CAP_ERRORPALSAVE = 405       '/* "Error saving palette '%s'" */
    Private Const IDS_CAP_ERRORDIBSAVE = 406       '/* "Error saving frame '%s'" */
    Private Const IDS_CAP_DEFAVIEXT = 407          '/* "avi" */
    Private Const IDS_CAP_DEFPALEXT = 408          '/* "pal" */
    Private Const IDS_CAP_CANTOPEN = 409           '/* "Cannot open '%s'" */
    Private Const IDS_CAP_SEQ_MSGSTART = 410       '/* "Select OK to start capture\nof video sequence\nto %s." */
    Private Const IDS_CAP_SEQ_MSGSTOP = 411        '/* "Hit ESCAPE or click to end capture" */
                    
    Private Const IDS_CAP_VIDEDITERR = 412         '/* "An error occurred while trying to run VidEdit." */
    Private Const IDS_CAP_READONLYFILE = 413       '/* "The file '%s' is a read-only file." */
    Private Const IDS_CAP_WRITEERROR = 414         '/* "Unable to write to file '%s'.\nDisk may be full." */
    Private Const IDS_CAP_NODISKSPACE = 415        '/* "There is no space to create a capture file on the specified device." */
    Private Const IDS_CAP_SETFILESIZE = 416        '/* "Set File Size" */
    Private Const IDS_CAP_SAVEASPERCENT = 417      '/* "SaveAs: %2ld%%  Hit Escape to abort." */
                    
    Private Const IDS_CAP_DRIVER_ERROR = 418       '/* Driver specific error message */Private Const IDS_CAP_WAVE_OPEN_ERROR = 419    '/* "Error: Cannot open the wave input device.\nCheck sample size, frequency, and channels." */
    Private Const IDS_CAP_WAVE_ALLOC_ERROR = 420   '/* "Error: Out of memory for wave buffers." */
    Private Const IDS_CAP_WAVE_PREPARE_ERROR = 421 '/* "Error: Cannot prepare wave buffers." */
    Private Const IDS_CAP_WAVE_ADD_ERROR = 422     '/* "Error: Cannot add wave buffers." */
    Private Const IDS_CAP_WAVE_SIZE_ERROR = 423    '/* "Error: Bad wave size." */
                    
    Private Const IDS_CAP_VIDEO_OPEN_ERROR = 424   '/* "Error: Cannot open the video input device." */
    Private Const IDS_CAP_VIDEO_ALLOC_ERROR = 425  '/* "Error: Out of memory for video buffers." */
    Private Const IDS_CAP_VIDEO_PREPARE_ERROR = 426 '/* "Error: Cannot prepare video buffers." */
    Private Const IDS_CAP_VIDEO_ADD_ERROR = 427    '/* "Error: Cannot add video buffers." */
    Private Const IDS_CAP_VIDEO_SIZE_ERROR = 428   '/* "Error: Bad video size." */
                    
    Private Const IDS_CAP_FILE_OPEN_ERROR = 429    '/* "Error: Cannot open capture file." */
    Private Const IDS_CAP_FILE_WRITE_ERROR = 430   '/* "Error: Cannot write to capture file.  Disk may be full." */
    Private Const IDS_CAP_RECORDING_ERROR = 431    '/* "Error: Cannot write to 
      

  2.   

    ''初始化摄像头和摄像窗口
    Public Sub InitCamera(ByVal ParentWnd As Long, Optional ByVal Caption As String, Optional ByVal Border As Boolean)
    Dim lpszName    As String * 100
    Dim lpszVer     As String * 100
    Dim Caps        As CAPDRIVERCAPS ''这是个结构
    Dim I           As Integer
            
        '//用代码动态创建一个窗口
        capGetDriverDescriptionA 0, lpszName, 100, lpszVer, 100     '// 得到驱动程序的版本和名字
        ''WS_CAPTION Or WS_THICKFRAME Or WS_VISIBLE Or WS_CHILD
        mvarHwndVideo = capCreateCaptureWindowA(lpszName, IIf(Border, WS_CAPTION Or WS_THICKFRAME Or WS_VISIBLE Or WS_CHILD, WS_VISIBLE Or WS_CHILD), 0, 0, 160, 120, ParentWnd, 0)
        
        '// 设置该窗口的caption
        SetWindowText mvarHwndVideo, Caption
        
        '// Set the video stream callback function
        
        '// Connect the capture window to the driver
        If capDriverConnect(mvarHwndVideo, 0) Then
            '/////
            '// Only do the following if the connect was successful.
            '// if it fails, the error will be reported in the call
            '// back function.
            '/////
            '// Get the capabilities of the capture driver
            capDriverGetCaps mvarHwndVideo, VarPtr(Caps), Len(Caps)
            
            '// If the capture driver does not support a dialog, grey it out
            '// in the menu bar.
            'If Caps.fHasDlgVideoSource = 0 Then mnuSource.Enabled = False
            'If Caps.fHasDlgVideoFormat = 0 Then mnuFormat.Enabled = False
            'If Caps.fHasDlgVideoDisplay = 0 Then mnuDisplay.Enabled = False
            
            '// Turn Scale on
            capPreviewScale mvarHwndVideo, True
                
            '// Set the preview rate in milliseconds
            capPreviewRate mvarHwndVideo, 66
            
            '// Start previewing the image from the camera
            capPreview mvarHwndVideo, True
                
            '// Resize the capture window to show the whole image
            ResizeCaptureWindow mvarHwndVideo    End If
    End Sub
    ''调整显示窗体的大小,这是根据分辨率调整的
    Private Sub ResizeCaptureWindow(ByVal lwnd As Long)    Dim CAPSTATUS As CAPSTATUS
        Dim lCaptionHeight As Long
        Dim lX_Border As Long
        Dim lY_Border As Long
        
        
        lCaptionHeight = GetSystemMetrics(SM_CYCAPTION)
        lX_Border = GetSystemMetrics(SM_CXFRAME)
        lY_Border = GetSystemMetrics(SM_CYFRAME)
        
        '// Get the capture window attributes .. width and height
        If capGetStatus(lwnd, VarPtr(CAPSTATUS), Len(CAPSTATUS)) Then
            
            '// Resize the capture window to the capture sizes
            SetWindowPos lwnd, HWND_BOTTOM, 0, 0, _
                               (CAPSTATUS.uiImageWidth + (lX_Border * 2)), _
                               (CAPSTATUS.uiImageHeight + lCaptionHeight + (lY_Border * 2)), _
                               SWP_NOMOVE Or SWP_NOZORDER
        End If    '//Debug.Print "Resize Window."End Sub