vb 控制摄像头(网上转的,备用)

测试的时候 需要新建两个 command,一个 combo,一个timer 控件

 

代码

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
   Picture2.Picture  =  Clipboard.GetData
   
   Clipboard.Clear
   
End Sub

 

转载于:https://www.cnblogs.com/lano/archive/2010/04/17/1714369.html