VB 调用摄像头拍照，保存。

摄像头调控

1、首先创建一个标准EXE工程

 

2、在窗体代码中加入如下必需的API及一个拍照的自定义函数

 

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 Preview_Handle As Long

 

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 Function CapturePicture(nCaptureHandle As Long) As StdPicture

Clipboard.Clear

SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0

Set CapturePicture = Clipboard.GetData

End Function

 

3、在窗体上加入一个Picturebox和两个button,一个caption为拍照，一个为保存

 

4、给窗体的Load加如下代码

 

Preview_Handle = capCreateCaptureWindow("Video", WS_CHILD + WS_VISIBLE, 2, 2, 220, 156, Me.hwnd, 1)

SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, 0, 0

SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 1, 0

SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0

 

5、双击拍照按钮

 

Picture1.Picture = CapturePicture(Preview_Handle)

 

6、双击保存按钮

 

SavePicture Picture1.Picture, "c:\a.bmp"

 

7、在窗体的unload事件中加入如下代码

 

SendMessage Preview_Handle, WM_CAP_DRIVER_DISCONNECT, 0, 0

 

8、运行程序，调试

 

全部程序清单：

 

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 Preview_Handle As Long

 

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 Function CapturePicture(nCaptureHandle As Long) As StdPicture

Clipboard.Clear

SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0

Set CapturePicture = Clipboard.GetData

End Function

 

Private Sub Command1_Click()

SavePicture Picture1.Picture, "c:\a.bmp"

End Sub

 

Private Sub Command2_Click()

Picture1.Picture = CapturePicture(Preview_Handle)

End Sub

 

Private Sub Form_Load()

Preview_Handle = capCreateCaptureWindow("Video", WS_CHILD + WS_VISIBLE, 2, 2, 220, 156, Me.hwnd, 1)

SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, 0, 0

SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 1, 0

SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

SendMessage Preview_Handle, WM_CAP_DRIVER_DISCONNECT, 0, 0

End Sub