Мой Kbyte.Ru
Рассылка Kbyte.Ru
Группы на Kbyte.Ru
Партнеры Kbyte.Ru
Реклама
Сделано руками
Сделано руками
> Исходные коды - Неизвестно -

Visual Basic .NET - Железо и устройства

Все примеры / Железо и устройства

Класс для работы с Web-камерой

Автор: Неизвестно | добавлено: 06.03.2010, 14:21 | просмотров: 7551 (1+) | комментариев: 0 | рейтинг: *x7
Класс для работы с Web-камерой средствами Visual Basic .NET, а также пример его использования.

Код

'пример использования см. в прикрепленном ниже файле

Option Explicit On 
Option Strict On

Public Class iCam
#Region "Api/constants"

  Private Const WS_CHILD As Integer = &H40000000
  Private Const WS_VISIBLE As Integer = &H10000000
  Private Const SWP_NOMOVE As Short = &H2S
  Private Const SWP_NOZORDER As Short = &H4S
  Private Const WM_USER As Short = &H400S
  Private Const WM_CAP_DRIVER_CONNECT As Integer = WM_USER + 10
  Private Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_USER + 11
  Private Const WM_CAP_SET_VIDEOFORMAT As Integer = WM_USER + 45
  Private Const WM_CAP_SET_PREVIEW As Integer = WM_USER + 50
  Private Const WM_CAP_SET_PREVIEWRATE As Integer = WM_USER + 52
  Private Const WM_CAP_GET_FRAME As Long = 1084
  Private Const WM_CAP_COPY As Long = 1054
  Private Const WM_CAP_START As Long = WM_USER
  Private Const WM_CAP_STOP As Long = (WM_CAP_START + 68)
  Private Const WM_CAP_SEQUENCE As Long = (WM_CAP_START + 62)
  Private Const WM_CAP_SET_SEQUENCE_SETUP As Long = (WM_CAP_START + 64)
  Private Const WM_CAP_FILE_SET_CAPTURE_FILEA As Long = (WM_CAP_START + 20)

  Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Short, ByVal lParam As String) As Integer
  Private 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
  Private 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 Declare Function BitBlt Lib "GDI32.DLL" (ByVal hdcDest As IntPtr, ByVal nXDest As Integer, ByVal nYDest As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hdcSrc As IntPtr, ByVal nXSrc As Integer, ByVal nYSrc As Integer, ByVal dwRop As Int32) As Boolean

#End Region

  Private iDevice As String
  Private hHwnd As Integer
  Private lwndC As Integer

  Public iRunning As Boolean

  Private CamFrameRate As Integer = 15
  Private OutputHeight As Integer = 240
  Private OutputWidth As Integer = 360

  Public Sub resetCam()
    'resets the camera after setting change
    If iRunning Then
      closeCam()
      Application.DoEvents()

      If setCam() = False Then
        MessageBox.Show("Errror Setting/Re-Setting Camera")
      End If
    End If

  End Sub

  Public Sub initCam(ByVal parentH As Integer)
    'Gets the handle and initiates camera setup
    If Me.iRunning = True Then
      MessageBox.Show("Camera Is Already Running")
      Exit Sub
    Else

      hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, OutputWidth, CShort(OutputHeight), parentH, 0)


      If setCam() = False Then
        MessageBox.Show("Error setting Up Camera")
      End If
    End If
  End Sub

  Public Sub setFrameRate(ByVal iRate As Long)
    'sets the frame rate of the camera
    CamFrameRate = CInt(1000 / iRate)

    resetCam()

  End Sub

  Private Function setCam() As Boolean
    'Sets all the camera up
    If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, CShort(iDevice), CType(0, String)) = 1 Then
      SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, CShort(CamFrameRate), CType(0, String))
      SendMessage(hHwnd, WM_CAP_SET_PREVIEW, 1, CType(0, String))
      Me.iRunning = True
      Return True
    Else
      Me.iRunning = False
      Return False
    End If
  End Function

  Public Function closeCam() As Boolean
    'Closes the camera
    If Me.iRunning Then
      closeCam = CBool(SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, 0, CType(0, String)))
      Me.iRunning = False
    End If
  End Function

  Public Function copyFrame(ByVal src As PictureBox, ByVal rect As RectangleF) As Bitmap
    If iRunning Then
      Dim srcPic As Graphics = src.CreateGraphics
      Dim srcBmp As New Bitmap(src.Width, src.Height, srcPic)
      Dim srcMem As Graphics = Graphics.FromImage(srcBmp)


      Dim HDC1 As IntPtr = srcPic.GetHdc
      Dim HDC2 As IntPtr = srcMem.GetHdc

      BitBlt(HDC2, 0, 0, CInt(rect.Width), _
       CInt(rect.Height), HDC1, CInt(rect.X), CInt(rect.Y), 13369376)

      copyFrame = CType(srcBmp.Clone(), Bitmap)

      'Clean Up 
      srcPic.ReleaseHdc(HDC1)
      srcMem.ReleaseHdc(HDC2)
      srcPic.Dispose()
      srcMem.Dispose()
    Else
      MessageBox.Show("Camera Is Not Running!")
    End If
  End Function

  Public Function FPS() As Integer
    Return CInt(1000 / (CamFrameRate))
  End Function

End Class
Файлы webcamviewer.zip (28,64 Кб)
Об авторе

Неизвестно

Нет информации об авторе...
Неизвестно
Последние комментарии (всего: 0)

Добавлять комментарии могут только зарегистрированные пользователи сайта.
Если у Вас уже есть учетная запись на Kbyte.Ru, пройдите процедуру авторизации OpenID.
Если Вы еще не зарегистрированы на Kbyte.Ru - зарегистрируйтесь.


Нет комментариев...

Авторизация
 
OpenID
Зарегистрируйся и получи 10% скидку на добавление своего сайта в каталоги! Подробнее »
Поиск по сайту
Люди на Kbyte.Ru
Реклама
Счетчики