标题:求助:vb2008如何控制摄像头,打开摄像头->拍照
只看楼主
weif021
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2012-11-4
 问题点数:0 回复次数:4 
求助:vb2008如何控制摄像头,打开摄像头->拍照
请大虾们帮忙
搜索更多相关主题的帖子: 摄像头 拍照 如何 
2012-11-04 11:41
gqdsc
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2012-12-3
得分:0 
这个我也想知道,呵呵
2012-12-04 11:33
jianjunfeng
Rank: 3Rank: 3
等 级:论坛游侠
威 望:5
帖 子:42
专家分:166
注 册:2009-3-13
得分:0 
mports System
Imports System.Data
Imports System.Data.SqlClient
Imports
Imports System.Windows.Forms
Imports System.Drawing
Public Class Frm_cam
    Const WM_CAP As Short = &H400S
    Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
    Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
    Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
    Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
    Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
    Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
    Const WS_CHILD As Integer = &H40000000
    Const WS_VISIBLE As Integer = &H10000000
    Const SWP_NOMOVE As Short = &H2S
    Const SWP_NOSIZE As Short = 1
    Const SWP_NOZORDER As Short = &H4S
    Const HWND_BOTTOM As Short = 1

    Dim iDevice As Integer = 0  ' Normal device ID
    Dim hHwnd As Integer  ' Handle value to preview window
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
         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

    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 hWndParent As Integer, _
        ByVal nID As Integer) As Integer

    Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, _
        ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
        ByVal cbVer As Integer) As Boolean
    Private Sub LoadDeviceList()
        Dim strName As String = Space(100)
        Dim strVer As String = Space(100)
        Dim bReturn As Boolean
        Dim x As Integer = 0
        Do
            bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
            If bReturn Then Me.ListBox1.Items.Add(strName.Trim)
            x += 1
        Loop Until bReturn = False
    End Sub
    Private Sub OpenPreviewWindow()
        Dim iHeight As Integer = Me.PictureBox1.Height
        Dim iWidth As Integer = Me.PictureBox1.Width
        hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
            480, Me.PictureBox1.Handle.ToInt32, 0)
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
            SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
            SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, Me.PictureBox1.Width, Me.PictureBox1.Height, _
                                   SWP_NOMOVE Or SWP_NOZORDER)
            Me.Label4.Text = ""
            Me.Button3.Enabled = True
            Me.Button2.Enabled = True
            Me.Button1.Enabled = False
        Else
            Me.Label4.Text = "没有可使用的摄像头!!!"
            DestroyWindow(hHwnd)
            Me.Button3.Enabled = False
        End If
    End Sub
    Private Sub ClosePreviewWindow()
        SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
        DestroyWindow(hHwnd)
        Me.Button1.Enabled = True
    End Sub
    Private Sub Frm_cam_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Label4.Text = ""
        Call LoadDeviceList()
        Call OpenPreviewWindow()
    End Sub
    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        If MsgBox("确认要保存物料编号为:" & Me.Text.Trim & "的图片资料?", 1 + 32, "系统提示") = MsgBoxResult.Ok Then
            Call Fu()
        End If
    End Sub
    Sub Fu()
        Dim data As IDataObject
        Dim bmap As Image
        SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
        data = Clipboard.GetDataObject()
        Try
            If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
                bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
                Me.PictureBox1.Image = bmap
                Me.Button3.Enabled = False
                Me.Button2.Enabled = False
                Me.Button1.Enabled = True
                Dim str As String = Me.Text.Trim
                Dim A As String, B As String, C As String
                A = "pic"
                B = "prd_no"
                C = str
                Dim con As New SqlConnection(Fstr)
                con.Open()
                Dim sqlstr As String = "select prd_no from prdt where prd_no='" & C & "'"
                Dim cmd As New SqlCommand(sqlstr, con)
                Dim reader As SqlDataReader
                reader = cmd.ExecuteReader
                If reader.Read() = True Then
                    reader.Close()
                Else
                    reader.Close()
                    Dim H As String = "insert into prdt(prd_no)values('" & C & "')"
                    Dim cmd3 As New SqlCommand(H, con)
                    cmd3.ExecuteNonQuery()
                End If
                con.Close()
                保存图片(A, B, C, Me.PictureBox1, Fstr)
            End If
        Catch e As Exception
            MessageBox.Show(e.ToString())
        Finally

        End Try
    End Sub
    Sub 保存图片(ByVal 表名 As String, ByVal 列名 As String, ByVal 字符 As String, ByVal pI As PictureBox, ByVal str As String)
        Dim con As New SqlConnection(str)
        Dim command As New SqlCommand("UPDATE prdt SET " & 表名 & " = @Picture WHERE " & 列名 & " = '" & 字符 & "'", con)
        Using picture As Image = pI.Image
            Using stream As New IO.MemoryStream
                picture.Save(stream, Imaging.ImageFormat.Jpeg)
                command.Parameters.Add("@Picture", SqlDbType.VarBinary).Value = stream.GetBuffer()
            End Using
        End Using
        con.Open()
        command.ExecuteNonQuery()
        con.Close()
        MsgBox("图片已录入数据库!", 0 + 48, "系统提示")
        Me.Close()
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Call ClosePreviewWindow()
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Call OpenPreviewWindow()
    End Sub
End Class
2012-12-20 09:00
sammilxm
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2012-12-26
得分:0 
研究一下,谢谢分享。
2012-12-29 10:30
大风起兮
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2012-12-29
得分:0 
看不懂呀。
2012-12-29 11:04



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-385848-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.031151 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved