prjCameraAccess - Camera Access - 访问摄像头 - Visual Basic 6 + API

最新推荐文章于 2022-06-06 17:11:44 发布

原创最新推荐文章于 2022-06-06 17:11:44 发布 · 1.9k 阅读

1 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#basic #access #integer #user #function

API Programe（纯 API 编程）同时被 3 个专栏收录

23 篇文章

订阅专栏

Visual Basic 6

13 篇文章

订阅专栏

Windows

12 篇文章

订阅专栏

本文介绍了一个使用Visual Basic 6和API实现的摄像头访问程序。该程序通过调用API函数能够打开摄像头并设置预览窗口，同时提供了连接和断开摄像头的功能，以及调整视频格式选项。

prjCameraAccess - Camera Access - 访问摄像头 - Visual Basic 6 + API

modAPI.bas

Option Explicit

Global Const ws_child As Long = &H40000000
Global Const ws_visible As Long = &H10000000

Global Const WM_USER = 1024
Global Const wm_cap_driver_connect = WM_USER + 10
Global Const wm_cap_set_preview = WM_USER + 50
Global Const WM_CAP_SET_PREVIEWRATE = WM_USER + 52
Global Const WM_CAP_DRIVER_DISCONNECT As Long = WM_USER + 11
Global Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_USER + 41

Public Declare Function SendMessage 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 capCreateCaptureWindow Lib "avicap32.dll" Alias "capCreateCaptureWindowA" (ByVal a As String, ByVal b As Long, ByVal c As Integer, ByVal d As Integer, ByVal e As Integer, ByVal f As Integer, ByVal g As Long, ByVal h As Integer) As Long

frmMain.frm

Option Explicit

Dim hwdc As Long
Dim startcap As Boolean

Private Sub cmdCapture_Click()
Dim temp As Long

    hwdc = capCreateCaptureWindow("Dixanta Vision System", ws_child Or ws_visible, 0, 0, 320, 240, Picture1.hWnd, 0)
    If (hwdc <> 0) Then
        temp = SendMessage(hwdc, wm_cap_driver_connect, 0, 0)
        temp = SendMessage(hwdc, wm_cap_set_preview, 1, 0)
        temp = SendMessage(hwdc, WM_CAP_SET_PREVIEWRATE, 30, 0)
        startcap = True
    Else
        MsgBox ("No Webcam found")
    End If
End Sub

Private Sub cmdClose_Click()
    Dim temp As Long
    If startcap = True Then
        temp = SendMessage(hwdc, WM_CAP_DRIVER_DISCONNECT, 0&, 0&)
        startcap = False
    End If
End Sub

Private Sub cmdVideoFormat_Click()
    Dim temp As Long
    If startcap = True Then
        temp = SendMessage(hwdc, WM_CAP_DLG_VIDEOFORMAT, 0&, 0&)
    End If
End Sub