vb攝像頭源碼

① 誰能用vb編寫攝像頭拍照程序

用 VFW 函數集即可實現
都是系統提供的 不算是第三方

步驟比較簡單 只需要幾步調用即可
VFW 提供了抓拍動態視頻和靜態圖片的函數

詳細的 VFW 函數調用方法 請查一下 MSDN
都是 cap 開頭的函數
比如 capCreateCaptureWindow 等等

② 誰能給個用VB調用攝像頭並保存的代碼

運用這段簡單的代碼，可以用VB輕松地打開攝像頭拍照，改動後可實現後台拍照！模塊代碼

"avicap32.dll"_
Alias"capCreateCaptureWindowA"(_
ByVallpszWindowNameAsString,_
ByValdwStyleAsLong,_
ByValxAsLong,_
ByValyAsLong,_
ByValnWidthAsLong,_
ByValnHeightAsLong,_
ByValhWndParentAsLong,_
ByValnIDAsLong)AsLong
PrivateConstWS_CHILD=&H40000000
PrivateConstWS_VISIBLE=&H10000000
PrivateConstWM_USER=&H400
PrivateConstWM_CAP_START=&H400
PrivateConstWM_CAP_EDIT_COPY=(WM_CAP_START+30)
PrivateConstWM_CAP_DRIVER_CONNECT=(WM_CAP_START+10)
PrivateConstWM_CAP_SET_PREVIEWRATE=(WM_CAP_START+52)
PrivateConstWM_CAP_SET_OVERLAY=(WM_CAP_START+51)
PrivateConstWM_CAP_SET_PREVIEW=(WM_CAP_START+50)
PrivateConstWM_CAP_DRIVER_DISCONNECT=(WM_CAP_START+11)
"user32"_
Alias"SendMessageA"(_
ByValhwndAsLong,_
ByValwMsgAsLong,_
ByValwParamAsLong,_
lParamAsAny)AsLong
PrivatePreview_HandleAsLong
(_
hWndParentAsLong,_
OptionalxAsLong=0,_
OptionalyAsLong=0,_
OptionalnWidthAsLong=320,_
OptionalnHeightAsLong=240,_
OptionalnCameraIDAsLong=0)AsLong
Preview_Handle=capCreateCaptureWindow("Video",_
WS_CHILD+WS_VISIBLE,x,y,_
nWidth,nHeight,hWndParent,1)
SendMessagePreview_Handle,WM_CAP_DRIVER_CONNECT,nCameraID,0
SendMessagePreview_Handle,WM_CAP_SET_PREVIEWRATE,30,0
SendMessagePreview_Handle,WM_CAP_SET_OVERLAY,1,0
SendMessagePreview_Handle,WM_CAP_SET_PREVIEW,1,0
CreateCaptureWindow=Preview_Handle
EndFunction
PublicFunctionCapturePicture(nCaptureHandleAsLong)AsStdPicture
Clipboard.Clear
SendMessagenCaptureHandle,WM_CAP_EDIT_COPY,0,0
SetCapturePicture=Clipboard.GetData
EndFunction
PublicSubDisconnect(nCaptureHandleAsLong,_
OptionalnCameraID=0)
SendMessagenCaptureHandle,WM_CAP_DRIVER_DISCONNECT,_
nCameraID,0
EndSub
'在form上添加一個PictureBox,名稱改為PicCapture,一個按鈕,名稱為Command1。
DimVideo_HandleAsLong
PrivateSubForm_Load()
Video_Handle=CreateCaptureWindow(PicCapture.hwnd)
EndSub
PrivateSubCommand1_Click()
DimxAsStdPicture
Setx=CapturePicture(Video_Handle)
SavePicturex,"c:a.bmp"'拍照保存
EndSub
PrivateSubForm_Unload(CancelAsInteger)
DisconnectVideo_Handle
EndSub

③ 使用VB語言編寫，在界面上畫個框，裡面顯示攝像頭里的圖像

就是用攝像頭來拍個照嘛...

'一個VB製作攝像頭拍照的源碼，如下：
"avicap32.dll"_
Alias"capCreateCaptureWindowA"(_
ByVallpszWindowNameAsString,_
ByValdwStyleAsLong,_
ByValxAsLong,_
ByValyAsLong,_
ByValnWidthAsLong,_
ByValnHeightAsLong,_
ByValhWndParentAsLong,_
ByValnIDAsLong)AsLong
PrivateConstWS_CHILD=&H40000000
PrivateConstWS_VISIBLE=&H10000000
PrivateConstWM_USER=&H400
PrivateConstWM_CAP_START=&H400
PrivateConstWM_CAP_EDIT_COPY=(WM_CAP_START+30)
PrivateConstWM_CAP_DRIVER_CONNECT=(WM_CAP_START+10)
PrivateConstWM_CAP_SET_PREVIEWRATE=(WM_CAP_START+52)
PrivateConstWM_CAP_SET_OVERLAY=(WM_CAP_START+51)
PrivateConstWM_CAP_SET_PREVIEW=(WM_CAP_START+50)
PrivateConstWM_CAP_DRIVER_DISCONNECT=(WM_CAP_START+11)
PrivatePreview_HandleAsLong
"user32"_
Alias"SendMessageA"(_
ByValhwndAsLong,_
ByValwMsgAsLong,_
ByValwParamAsLong,_
lParamAsAny)AsLong
PrivateFunctionCapturePicture(nCaptureHandleAsLong)AsStdPicture
Clipboard.Clear
SendMessagenCaptureHandle,WM_CAP_EDIT_COPY,0,0
SetCapturePicture=Clipboard.GetData
EndFunction
PrivateSubcmdCap_Click()
Picture1.Picture=CapturePicture(Preview_Handle)
EndSub
PrivateSubcmdSave_Click()
OnErrorResumeNext
SavePicturePicture1.Picture,"C:"&Format(Date,"dd-MM-yyyy")&""&Format(Time,"hh-mm-ss")&".bmp"
EndSub
PrivateSubForm_Load()
Preview_Handle=capCreateCaptureWindow("Video",WS_CHILD+WS_VISIBLE,2,2,320,240,Me.hwnd,1)
SendMessagePreview_Handle,WM_CAP_DRIVER_CONNECT,0,0
SendMessagePreview_Handle,WM_CAP_SET_PREVIEWRATE,1,0
SendMessagePreview_Handle,WM_CAP_SET_PREVIEW,1,0
EndSub
PrivateSubForm_Unload(CancelAsInteger)
SendMessagePreview_Handle,WM_CAP_DRIVER_DISCONNECT,0,0
EndSub

④ 求教如何用vb程序實現打開自己攝像頭，要全代碼

最簡單的一個

Private Const WS_CHILD = &H40000000
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開
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

⑤ vb6 無驅攝像頭編程 求源碼

發下是我幾年前寫的(參照)一個VB驅動攝像頭的代碼,不知道現在還能不能用,因為文件總的很長,這只是其中的一小部分,希望對你有所用.(要不就和我聯系,給你源碼)
Private Sub Form_Load()
On Error Resume Next
Dim retVal As Boolean
Dim numDevs As Long
bCaramaPlaying = True
'load trivial settings first
Me.BackColor = Val(GetSetting(App.Title, "preferences", "backcolor", "&H404040")) 'default to dk gray

numDevs = VBEnumCapDrivers(Me)
If 0 = numDevs Then
MsgBox "沒有找到視頻捕捉設備!", vbCritical, App.Title
' frmPlayer.Visible = True
' If bIsVisible = True And vbPlayFormIsVisible = True And vbFrmPlayFrameHided = False Then
' frmPlayFrame.Visible = True
' End If
Unload Me
Exit Sub
End If
nDriverIndex = Val(GetSetting(App.Title, "driver", "index", "0"))
'if invalid entry is in registry use default (0)
If mnuDriver.UBound < nDriverIndex Then
nDriverIndex = 0
End If
mnuDriver(nDriverIndex).Checked = True
'//Create Capture Window
'Call capGetDriverDescription( nDriverIndex, lpszName, 100, lpszVer, 100 '// Retrieves driver info
hCapWnd = capCreateCaptureWindow("VB CAP WINDOW", WS_CHILD Or WS_VISIBLE, 0, 0, 160, 120, Me.hWnd, 0)
If 0 = hCapWnd Then
MsgBox "不能創建捕捉窗口!", vbCritical, App.Title
Exit Sub
End If
retVal = ConnectCapDriver(hCapWnd, nDriverIndex)
If False = retVal Then
MsgBox "不能連接到視頻設備!", vbInformation, App.Title
Else
#If USECALLBACKS = 1 Then
' if we have a valid capwnd we can enable our status callback function
Call capSetCallbackOnStatus(hCapWnd, AddressOf StatusProc)
Debug.Print "---Callback set on capture status---"
#End If
End If
'// Set the video stream callback function
' capSetCallbackOnVideoStream lwndC, AddressOf MyVideoStreamCallback
' capSetCallbackOnFrame lwndC, AddressOf MyFrameCallback

Dim bPlayFrameTop As Boolean
bPlayFrameTop = GetSetting(MyName, "setting" & "-" & Trim(Str(App.Major)) & "-" & Trim(Str(App.Minor)), "bPlayFrameTop", "False")
If bPlayFrameTop = True Then
Me.mnuOptionTop.Checked = True
'放在最前
SetWindowPos Me.hWnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, &H20
Else
Me.mnuOptionTop.Checked = False
'不放在最前
SetWindowPos Me.hWnd, HWND_NOTOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, &H20
End If
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
Me.picShowMenu.ZOrder 0

End Sub

'以下是一個模塊文件
Option Explicit

'application specific routines are here

Public Const ONE_MEGABYTE As Long = 1048576
'Public Const MMSYSERR_NOERROR As Long = 0
Public Const INDEX_15_MINUTES As Long = 27000 '(30fps * 60sec * 15min)
Public Const INDEX_3_HOURS As Long = 324000 ' (30fps * 60sec * 60min * 3hr)

Public Function GetFreeSpace() As Long
'this function gets the amount of free disk space and adds the size
'of the current capture file
Dim freedisk As Long
Dim path As String

'get Cap File length
path = capFileGetCaptureFile(frmCaramaMain.capwnd)
If path <> "" Then
On Error Resume Next
freedisk = FileLen(path)
freedisk = freedisk / ONE_MEGABYTE
End If

'now get free disk space from that drive
path = Left$(path, 3)
GetFreeSpace = freedisk + vbGetAvailableMBytes(path)

End Function

Sub ResizeCaptureWindow(ByVal hCapWnd As Long)
Dim retVal As Boolean
Dim capStat As CAPSTATUS

'Get the capture window attributes
retVal = capGetStatus(hCapWnd, capStat)

If retVal Then
'Resize the main form to fit
Call SetWindowPos(frmCaramaMain.hWnd, _
0&, _
0&, _
0&, _
capStat.uiImageWidth + (frmCaramaMain.XBorder * 2), _
capStat.uiImageHeight + (frmCaramaMain.YBorder * 4) _
+ frmCaramaMain.CaptionHeight + frmCaramaMain.MenuHeight, _
Swp_nomove Or SWP_NOZORDER Or SWP_NOSENDCHANGING)
'Resize the capture window to format size
Call SetWindowPos(hCapWnd, _
0&, _
0&, _
0&, _
capStat.uiImageWidth, _
capStat.uiImageHeight, _
Swp_nomove Or SWP_NOZORDER Or SWP_NOSENDCHANGING)
End If
Call frmCaramaMain.Form_Resize
End Sub

Public Function VBEnumCapDrivers(ByRef frm As frmCaramaMain) As Long
'/*
' * Enumerate the potential capture drivers and add the list to the Options
' * menu. This function is only called once at startup.
' * Returns 0 if no drivers are available.
' */
Const MAXVIDDRIVERS As Long = 9
Const CAP_STRING_MAX As Long = 128
Dim numDrivers As Long
Dim driverStrings(0 To MAXVIDDRIVERS - 1) As String
Dim Index As Long
Dim Device As String
Dim Version As String
Dim menu As VB.menu

Device = String$(CAP_STRING_MAX, 0)
Version = String$(CAP_STRING_MAX, 0)
numDrivers = 0
For Index = 0 To (MAXVIDDRIVERS - 1) Step 1
If 0 <> capGetDriverDescription(Index, _
Device, _
CAP_STRING_MAX, _
Version, _
CAP_STRING_MAX) _
Then
'extend the menu
If Index > 0 Then
Load frm.mnuDriver(Index)
End If
Set menu = frm.mnuDriver(Index) 'get an object pointer to the new menu
'Concatenate the device name and version strings to the new menu item
menu.Caption = Left$(Device, InStr(Device, vbNullChar) - 1)
menu.Caption = menu.Caption & " "
menu.Caption = menu.Caption & Left$(Version, InStr(Version, vbNullChar) - 1)
menu.Enabled = True
numDrivers = numDrivers + 1
End If

Next
VBEnumCapDrivers = numDrivers
End Function

Public Function ConnectCapDriver(ByVal hCapWnd As Long, ByVal nDriverIndex As Long) As Boolean
Dim retVal As Boolean
Dim Caps As CAPDRIVERCAPS
Dim i As Long

Debug.Assert (nDriverIndex < 10) And (nDriverIndex >= 0)
'// Connect the capture window to the driver
retVal = capDriverConnect(hCapWnd, nDriverIndex)
If False = retVal Then
'return False
Exit Function
End If
'// Get the capabilities of the capture driver
retVal = capDriverGetCaps(hCapWnd, Caps)

If False <> retVal Then
'reset menus (very app-specific)
With frmCaramaMain
For i = 0 To .mnuDriver.UBound
.mnuDriver(i).Checked = False 'make sure all drivers are unchecked
Next
.mnuDriver(nDriverIndex).Checked = True 'then check the new driver
'disable all hardware feature menu items
.mnuSource.Enabled = False
.mnuFormat.Enabled = False
.mnuDisplay.Enabled = False
.mnuOverlay.Enabled = False
'Then enable the ones which are supported by the new driver
If Caps.fHasDlgVideoSource <> 0 Then .mnuSource.Enabled = True
If Caps.fHasDlgVideoFormat <> 0 Then .mnuFormat.Enabled = True
If Caps.fHasDlgVideoDisplay <> 0 Then .mnuDisplay.Enabled = True
If Caps.fHasOverlay <> 0 Then .mnuOverlay.Enabled = True

End With
End If
'// Set the preview rate in milliseconds
Call capPreviewRate(hCapWnd, 66) '15 FPS

'// Start previewing the image from the camera
Call capPreview(hCapWnd, True)
'default to showing a preview each time
frmCaramaMain.mnuPreview.Checked = True

'// Resize the capture window to show the whole image
Call ResizeCaptureWindow(hCapWnd)
ConnectCapDriver = True
End Function
Public Function StatusProc(ByVal hCapWnd As Long, ByVal StatusCode As Long, ByVal lpStatusString As Long) As Long
Select Case StatusCode
Case 0 'this is recommended in docs
'when zero is sent, clear old status messages
'frmCaramaMain.Caption = App.Title
Case IDS_CAP_END ' Video Capture has finished
frmCaramaMain.Caption = App.Title
Case IDS_CAP_STAT_VIDEOAUDIO, IDS_CAP_STAT_VIDEOONLY
MsgBox LPSTRtoVBString(lpStatusString), vbInformation, App.Title
Case Else
'use this function if you need a real VB string
'frmCaramaMain.Caption = LPSTRtoVBString(lpStatusString)

'or, just pass the LPCSTR to a WINAPI function
Call SetWindowTextAsLong(frmCaramaMain.hWnd, lpStatusString)
End Select
Debug.Print "Driver returned code " & StatusCode & " to StatusProc"
StatusProc = -(True) '- converts Boolean to C BOOL
End Function

⑥ vb 製作攝像頭視頻拍照程序

以面代碼是我以前用的,win7應該也支持你試試

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 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 GET_FRAME As Long = 1084
Private Const COPY As Long = 1054
Private Const CONNECT As Long = 1034
Private Const DISCONNECT As Long = 1035
Private CapHwnd As Long
Private Sub Command1_Click() '截圖按鈕
On Error Resume Next
SendMessage CapHwnd, GET_FRAME, 0, 0
SendMessage CapHwnd, COPY, 0, 0
Image2.Picture = Clipboard.GetData
Clipboard.Clear
End Sub
Private Sub Form_Load()
'打開攝像頭
CapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 320, 240, Me.hwnd, 0)
DoEvents
SendMessage CapHwnd, CONNECT, 0, 0
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
'停止攝像頭
DoEvents: SendMessage CapHwnd, DISCONNECT, 0, 0
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer() 'timer1.Interval=50
On Error Resume Next
SendMessage CapHwnd, GET_FRAME, 0, 0
SendMessage CapHwnd, COPY, 0, 0
Image1.Picture = Clipboard.GetData
Clipboard.Clear
End Sub
'
'Private Sub Timer2_Timer()
'Static z
'z = z + 1
'SavePicture Image1.Picture, "c:\1\" & z & ".BMP" ' 將圖片保存到文件。
'
'End Sub

⑦ 我想問下，用vb編寫一個後台打開攝像頭的代碼應該怎麼寫或者直接打開，不需要後台，該怎麼編寫希望

編寫程序需要用到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

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

參考：http://blog.csdn.net/kalision/article/details/8057246

⑧ 有關用vb調攝像頭的程序代碼。真的看不懂~555……

代的代碼沒問題
把最後三行去掉
VB控制攝像頭
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 Declare Function capCreateCaptureWindow Lib "avicap32.dll"
這三行

⑨ 求VB監控程序源代碼（使用用攝像頭）

攝像頭源代碼:
http://www.vbgood.com/viewthread.php?tid=49742&highlight=%C9%E3%CF%F1%CD%B7

⑩ 一個VB製作攝像頭拍照的問題

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

320.240改