網上搜索到的也沒有找到對應轉載地址。故原創自己記錄一下。
運用這段簡單的代碼,可以用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