向东博客 专注WEB应用 构架之美 --- 构架之美，在于尽态极妍 | 应用之美，在于药到病除|赢在IT，Playin' with IT,Focus on Killer Application,Marketing Meets Technology.

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()
   '打开摄像头
   CapHwnd = capCreateCaptureWindow("WebcamCapture", 0, 0, 0, 640, 480, Me.hwnd, 0)
   DoEvents
   SendMessage CapHwnd, CONNECT, 0, 0
   Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
   '停止摄像头
   DoEvents
   SendMessage CapHwnd, DISCONNECT, 0, 0
   Timer1.Enabled = False
  
End Sub
Private Sub Form_Load()
'几句代码实现控制摄像头,有摄像头的进哦
    Combo1.AddItem "160*120"
    Combo1.AddItem "176*144"
    Combo1.AddItem "320*240"
    Combo1.AddItem "352*288"
    Combo1.AddItem "640*480"
    Combo1.ListIndex = 0
    
End Sub
Private Sub Timer1_Timer() 'timer1.Interval=50
   On Error Resume Next
   SendMessage CapHwnd, GET_FRAME, 0, 0
   SendMessage CapHwnd, COPY, 0, 0
   Picture1.Picture = Clipboard.GetData
  
   Clipboard.Clear
  
End Sub