VB6.0 調用攝像頭並保存照片

網上搜索到的也沒有找到對應轉載地址。故原創自己記錄一下。

運用這段簡單的代碼,可以用VB輕鬆地打開攝像頭拍照,改e69da5e887aae79fa5e9819331333337383264動後可實現後臺拍照!模塊代碼

Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _   

  Alias "capCreateCaptureWindowA" ( _  

  ByVal lpszWindowName As String, _   

  ByVal dwStyle As Long, _   

  ByVal As Long, _   

  ByVal As Long, _   

  ByVal nWidth As Long, _   

  ByVal nHeight As Long, _   

  ByVal hWndParent As Long, _   

  ByVal nID As LongAs 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 As Long = 0, _  

  Optional 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 LongAs 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 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

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章