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

  • 0
    点赞
  • 5
    收藏
    觉得还不错? 一键收藏
  • 1
    评论
### 回答1: 以下是一个使用VB6.0控制摄像头拍照并存储照片的代码案例: 首先,你需要在VB6.0的工具箱中引入"Windows Image Acquisition Library v2.0"。 然后,在窗体上放置一个“Image”控件以显示拍到的照片。 接下来,添加一个按钮控件,命名为“BtnCapture”,用于触发拍照操作。 在窗体的代码模块中添加以下代码: ``` Dim WithEvents Camera As WIA.CommonDialog Private Sub Form_Load() Set Camera = New WIA.CommonDialog End Sub Private Sub BtnCapture_Click() Dim Image As WIA.ImageFile On Error Resume Next Set Image = Camera.ShowTransfer(Camera.ShowAcquireImage) '打开摄像头窗口 If Not Image Is Nothing Then '如果成功拍到照片 Image.SaveFile "D:\Photos\photo.jpg" '修改文件路径为你希望存储照片的位置和文件名 Set Image = Nothing '释放图像对象 '显示照片 Image1.Picture = LoadPicture("D:\Photos\photo.jpg") '同样修改文件路径为你存储照片的位置 Image1.Refresh End If End Sub ``` 以上代码中,点击按钮“BtnCapture”会打开摄像头窗口,拍照并将照片保存到指定文件路径。然后,使用控件“Image1”显示刚才拍的照片。 请注意,将“D:\Photos\photo.jpg”替换为你希望存储照片的文件路径和文件名。确保指定的文件夹存在,否则可能会出现错误。 希望对你有所帮助! ### 回答2: 以下是一个使用VB6.0控制摄像头拍照并存储照片的代码案例: 首先,你需要确保你的计算机上已经安装了摄像头相应的驱动程序和软件。 接下来,在VB6.0中创建一个新的Windows应用程序项目。 在窗体上添加一个Command按钮,命名为btnCapture,并添加一个Image控件,命名为imgPhoto。 在btnCapture的Click事件中添加以下代码: Private Sub btnCapture_Click() Dim cap As New VideoCap Dim photo As Image Set photo = imgPhoto.Picture ' 打开摄像头设备 If cap.StartVideo(DetectVideoCapture()) Then ' 截取当前摄像头画面并保存照片 cap.Snapshot photo ' 保存照片到指定路径 SavePicture photo, "C:\照片.jpg" ' 关闭摄像头设备 cap.StopVideo End If End Sub 点击运行,当你点击btnCapture按钮时,它将打开摄像头设备并截取当前摄像头画面,并将其保存照片照片将被保存在C盘根目录下,命名为“照片.jpg”。 请注意,上述代码中引用了一个名为VideoCap的自定义类。你需要在VB6.0项目中添加该类的模块,并在其中添加以下代码: Option Explicit 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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Function DetectVideoCapture() As Long Dim hWndC As Long Dim hWndP As Long hWndP = FindWindow(vbNullString, "Microsoft Windows") hWndC = capCreateCaptureWindow("CaptureWindow", &H10000000, 0, 0, 640, 480, hWndP, 0) DetectVideoCapture = hWndC End Function Public Function StartVideo(ByVal hWndC As Long) As Boolean Dim result As Long result = SendMessage(hWndC, &H400, 0, 0) StartVideo = result <> 0 End Function Public Function StopVideo(ByVal hWndC As Long) As Boolean Dim result As Long result = SendMessage(hWndC, &H401, 0, 0) StopVideo = result <> 0 End Function Public Function Snapshot(ByVal photo As Image) As Boolean Dim bytesTotal As Long Dim bytesSaved As Long Dim bitmapData() As Byte Dim bm As Bitmap Dim i As Integer Dim j As Integer bytesTotal = Image.Width * Image.Height * 3 ReDim bitmapData(bytesTotal) bytesSaved = SendMessage(hWndC, &H43C, bytesTotal, bitmapData(0)) If bytesSaved <> bytesTotal Then Snapshot = False Exit Function End If Set bm = New Bitmap(Image.Width, Image.Height, PixelFormat.Format24bppRgb) For i = 0 To Image.Height - 1 For j = 0 To Image.Width - 1 bm.SetPixel j, i, RGB(bitmapData(3 * (Image.Width * i + j) + 2), bitmapData(3 * (Image.Width * i + j) + 1), bitmapData(3 * (Image.Width * i + j))) Next j Next i photo.Picture = bm Snapshot = True End Function 请注意,上述VideoCap类的代码是用来封装了一些Windows API函数,用于检测摄像头设备、打开摄像头、关闭摄像头以及截取当前画面并保存的功能。 ### 回答3: VB6.0控制摄像头拍照并存储照片的代码案例如下: 1. 首先,需要在VB6.0中添加Microsoft Windows Image Acquisition Library (WIA)的引用。在VB6.0的开发环境中,依次点击“项目”->“引用”,在弹出的窗口中勾选“Microsoft Windows Image Acquisition Library v2.0”并点击确定。 2. 创建一个新的窗体,在窗体上放置一个命令按钮控件,命名为Command1。 3. 在命令按钮的OnClick事件中编写以下代码: ``` Private Sub Command1_Click() Dim WIA As New WIA.CommonDialog Dim Image As WIA.ImageFile On Error Resume Next Set Image = WIA.ShowAcquireImage If Image Is Nothing Then MsgBox "未检测到摄像头或摄像头不可用。" Else Dim SavePath As String SavePath = "C:\Images\photo.jpg" '请替换为你希望保存照片的路径和文件名 On Error Resume Next Image.SaveFile SavePath If Err.Number <> 0 Then MsgBox "保存照片出错。" Else MsgBox "照片保存至 " & SavePath End If End If End Sub ``` 4. 运行程序,点击按钮即可调用摄像头拍照,照片保存至指定路径。若未检测到摄像头或摄像头不可用,将弹出相应的提示。 需要注意的是,该代码案例使用了WIA库来控制摄像头拍照,使用前需要确保计算机上已经安装了摄像头并且摄像头可用,否则可能无法正常拍照。此外,还需要根据自己的需求修改保存路径和文件名。
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值