VB.NET怎么調(diào)用攝像頭啊?求實(shí)例,最好配注釋啊

Private Const WS_CHILD = H40000000

成都創(chuàng)新互聯(lián)公司專業(yè)為企業(yè)提供石景山網(wǎng)站建設(shè)、石景山做網(wǎng)站、石景山網(wǎng)站設(shè)計(jì)、石景山網(wǎng)站制作等企業(yè)網(wǎng)站建設(shè)、網(wǎng)頁(yè)設(shè)計(jì)與制作、石景山企業(yè)網(wǎng)站模板建站服務(wù)，十載石景山做網(wǎng)站經(jīng)驗(yàn)，不只是建網(wǎng)站，更提供有價(jià)值的思路和整體網(wǎng)絡(luò)服務(wù)。

Private Const WS_VISIBLE = H10000000

Private Const WM_CAP_START = H400

Private Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10

Private Const WM_CAP_SET_SCALE = WM_CAP_START + 53

Private Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52

Private Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50

Private Declare Function capCreateCaptureWindowA Lib "avicap32.dll" ( _

ByVal lpszWindowName As String, _

ByVal dwStyle As Long, _

ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Integer, _

ByVal hWndParent As Long, ByVal nID As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long

Private Sub Form_Load()

'建立采集窗口（賀耐不滲搏顯示窗口，處理后顯示到PIC控件）

uwndc = capCreateCaptureWindowA("", WS_VISIBLE Or WS_CHILD, 0, 0, 320, 240, Me.hWnd, 0)

'連接

SendMessage uwndc, WM_CAP_DRIVER_CONNECT, 0, 0

'Scale開(kāi)

SendMessage uwndc, WM_CAP_SET_SCALE, True, 0

'顯示刷新MS

SendMessage uwndc, WM_CAP_SET_PREVIEWRATE, 40, 0

'用予覽方式顯示(特殊需要，不顯示予纜）

SendMessage uwndc, WM_CAP_SET_PREVIEW, True, 0

End Sub

上述禪喊春代碼就可以實(shí)現(xiàn) 但是要注意相應(yīng)的控件是否存在 不存在的 你自己畫(huà)出來(lái)

VB.NET中怎么調(diào)用攝像頭

給你個(gè)工程自己看...

運(yùn)行后可以高老看到自己悄螞...

點(diǎn)按鈕保存到啟念埋c:\1.bmp

VB.NET 攝像頭編程求助

這是6.0的，點(diǎn)虐 的做些改動(dòng)就成！因?yàn)槲覜](méi)裝攝像頭，就沒(méi)改！ 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 4在form上添加一個(gè)PictureBox,一個(gè)按鈕,Caption設(shè)為 Save Pic 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 追問(wèn)： 可不可以幫忙寫(xiě)為VB.NET的程序..?我自己運(yùn)行后顯示 未聲明 PicCapture 追問(wèn)： nCameraID = 0 這里在VB.NET下也用不了Clipboard.GetData 在VB.NET里也要跟參數(shù)的..我自己試用VB可以的..希望你能幫忙寫(xiě)一個(gè)VB.NET的..因?yàn)榫退銢](méi)有攝像頭picturebox也會(huì)顯示黑色的 回答： 你這程序是工程用的！請(qǐng)加多點(diǎn)分！我給你改 追問(wèn)： 可不可以加我QQ先344568960 因?yàn)槲曳e分不多...或許我可以給Q幣你怎么的~可以嗎？ 追問(wèn)： 已經(jīng)補(bǔ)充了積分了~希望能幫忙改成VB.NET的吧~謝謝~ 回答： 建一個(gè)picturebox 和 button Imports System.Runtime.InteropServices Public Class Form1 Const WM_CAP_START = H400S Const WS_CHILD = H40000000 Const WS_VISIBLE = H10000000 Const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10 Const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11 Const WM_CAP_EDIT_COPY = WM_CAP_START + 30 Const WM_CAP_SEQUENCE = WM_CAP_START + 62 Const WM_CAP_FILE_SAVEAS = WM_CAP_START + 23 Const WM_CAP_SET_SCALE = WM_CAP_START + 53 Const WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52 Const WM_CAP_SET_PREVIEW = WM_CAP_START + 50 Const SWP_NOMOVE = H2S Const SWP_NOSIZE = 1 Const SWP_NOZORDER = H4S Const HWND_BOTTOM = 1 Dim hWnd As Integer Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _ (ByVal wDriverIndex As Short, _ ByVal lpszName As String, ByVal cbName As Integer, _ ByVal lpszVer As String, _ ByVal cbVer As Integer) As Boolean Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _ (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _ ByVal x As Integer, ByVal y As Integer, _ ByVal nWidth As Integer, _ ByVal nHeight As Short, ByVal hWnd As Integer, _ ByVal nID As Integer) As Integer Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Integer, ByVal Msg As Integer, _ ByVal wParam As Integer, _ Runtime.InteropServices.MarshalAs(UnmanagedType.AsAny) ByVal lParam As Object) _ As Integer Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _ (ByVal hwnd As Integer, _ ByVal hWndInsertAfter As Integer, ByVal x As Integer, _ ByVal y As Integer, _ ByVal cx As Integer, ByVal cy As Integer, _ ByVal wFlags As Integer) As Integer Declare Function DestroyWindow Lib "user32" _ (ByVal hndw As Integer) As Boolean Private Sub PreviewVideo(ByVal pbCtrl As PictureBox) hWnd = capCreateCaptureWindowA(0, _ WS_VISIBLE Or WS_CHILD, 0, 0, 0, _ 0, pbCtrl.Handle.ToInt32, 0) If SendMessage( _ hWnd, WM_CAP_DRIVER_CONNECT, _ 0, 0) Then SendMessage(hWnd, WM_CAP_SET_SCALE, True, 0) SendMessage(hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0) SendMessage(hWnd, WM_CAP_SET_PREVIEW, True, 0) SetWindowPos(hWnd, HWND_BOTTOM, 0, 0, _ pbCtrl.Width, pbCtrl.Height, _ SWP_NOMOVE Or SWP_NOZORDER) Else DestroyWindow(hWnd) End If End Sub Private Sub Form1_Load( _ ByVal sender As System.Object, _ ByVal e As System.EventArgs) Handles MyBase.Load PreviewVideo(PictureBox1) End Sub Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click Dim data As IDataObject Dim bmap As Image SendMessage(hWnd, WM_CAP_EDIT_COPY, 0, 0) data = Clipboard.GetDataObject() If data Is Nothing Then Exit Sub If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then bmap = CType(data.GetData(GetType( _ System.Drawing.Bitmap)), Image) bmap.Save("d:\a.bmp", System.Drawing.Imaging.ImageFormat.Bmp) MsgBox("完成") End If End Sub End Class

windows8.1下VB點(diǎn)虐 使用攝像頭

這個(gè)方法沒(méi)銀沖問(wèn)題。

win8.1，我用網(wǎng)上的鋒蠢殲方法，有時(shí)檔睜也有黑屏現(xiàn)象，但多試幾次就好了。有時(shí)還會(huì)彈出要選擇攝像頭，選擇確認(rèn)、取消、應(yīng)用都是黑屏。