网上搜索到的也没有找到对应转载地址。故原创自己记录一下。
运用这段简单的代码,可以用VB轻松地打开摄像头拍照,改e69da5e887aae79fa5e9819331333337383264动后可实现后台拍照!模块代码
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
Private
Const
WS_CHILD = &H40000000
Private
Const
WS_VISIBLE = &H10000000
Private
Const
WM_USER = &H400
Private
Const
WM_CAP_START = &H400
Private
Const
WM_CAP_EDIT_COPY = (WM_CAP_START + 30)
Private
Const
WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)
Private
Const
WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)
Private
Const
WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)
Private
Const
WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)
Private
Const
WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)
Private
Declare
Function
SendMessage
Lib
"user32"
_
Alias
"SendMessageA"
( _
ByVal
hwnd
As
Long
, _
ByVal
wMsg
As
Long
, _
ByVal
wParam
As
Long
, _
lParam
As
Any)
As
Long
Private
Preview_Handle
As
Long
Public
Function
CreateCaptureWindow( _
hWndParent
As
Long
, _
Optional
x
As
Long
= 0, _
Optional
y
As
Long
= 0, _
Optional
nWidth
As
Long
= 320, _
Optional
nHeight
As
Long
= 240, _
Optional
nCameraID
As
Long
= 0)
As
Long
Preview_Handle = capCreateCaptureWindow(
"Video"
, _
WS_CHILD + WS_VISIBLE, x, y, _
nWidth, nHeight, hWndParent, 1)
SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, nCameraID, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 30, 0
SendMessage Preview_Handle, WM_CAP_SET_OVERLAY, 1, 0
SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0
CreateCaptureWindow = Preview_Handle
End
Function
Public
Function
CapturePicture(nCaptureHandle
As
Long
)
As
StdPicture
Clipboard.Clear
SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0
Set
CapturePicture = Clipboard.GetData
End
Function
Public
Sub
Disconnect(nCaptureHandle
As
Long
, _
Optional
nCameraID = 0)
SendMessage nCaptureHandle, WM_CAP_DRIVER_DISCONNECT, _
nCameraID, 0
End
Sub
'在form上添加一个PictureBox,名称改为PicCapture,一个按钮,名称为Command1。
Dim
Video_Handle
As
Long
Private
Sub
Form_Load()
Video_Handle = CreateCaptureWindow(PicCapture.hwnd)
End
Sub
Private
Sub
Command1_Click()
Dim
x
As
StdPicture
Set
x = CapturePicture(Video_Handle)
SavePicture x,
"c:\a.bmp"
'拍照保存
End
Sub
Private
Sub
Form_Unload(Cancel
As
Integer
)
Disconnect Video_Handle
End
Sub