Advertisement
TheVideoVolcano

Webcam VB.NET Code

Dec 3rd, 2013
328
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VB.NET 4.42 KB | None | 0 0
  1. 'Form elements needed:
  2. '3 Buttons
  3. '1 Listbox
  4. '1 Picturebox
  5.  
  6. Const WM_CAP As Short = &H400S
  7.     Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
  8.     Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
  9.     Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30
  10.     Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
  11.     Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
  12.     Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
  13.     Const WS_CHILD As Integer = &H40000000
  14.     Const WS_VISIBLE As Integer = &H10000000
  15.     Const SWP_NOMOVE As Short = &H25
  16.     Const SWP_NOSIZE As Short = 1
  17.     Const SWP_NOZORDER As Short = &H4S
  18.     Const HWND_BOTTOM As Short = 1
  19.     Dim iDevice As Integer = 0
  20.     Dim hHwnd As Integer
  21.     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
  22.     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
  23.     Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean
  24.     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
  25.     Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, ByVal lpszName As String, ByVal vbName As Integer, ByVal lpszVer As String, ByVal cbVer As Integer) As Boolean
  26.  
  27.     Private Sub LoadDeviceList()
  28.         Dim strName As String = Space(100)
  29.         Dim strVer As String = Space(100)
  30.         Dim bReturn As Boolean
  31.         Dim x As Integer = 0
  32.         Do
  33.             bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)
  34.             If bReturn Then listDevices.Items.Add(strName.Trim)
  35.             x += 1
  36.         Loop Until bReturn = False
  37.     End Sub
  38.  
  39.     Private Sub OpenPreviewWindow()
  40.         Dim iHeight As Integer = picCapture.Height
  41.         Dim iWidth As Integer = picCapture.Width
  42.         hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, 480, picCapture.Handle.ToInt32, 0)
  43.         If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
  44.             SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)
  45.             SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)
  46.             SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)
  47.             setWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCapture.Width, picCapture.Height, SWP_NOMOVE Or SWP_NOZORDER)
  48.             btnSave.Enabled = True
  49.             btnStop.Enabled = True
  50.             btnStart.Enabled = False
  51.         Else
  52.             DestroyWindow(hHwnd)
  53.             btnSave.Enabled = False
  54.         End If
  55.     End Sub
  56.  
  57. Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
  58.  
  59.         LoadDeviceList()
  60.  
  61.     End Sub
  62.  
  63.  Private Sub btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSave.Click
  64.         Dim data As IDataObject
  65.         Dim BMAP As Image
  66.         SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)
  67.         data = Clipboard.GetDataObject()
  68.         If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
  69.             BMAP = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
  70.             picCapture.Image = BMAP
  71.             closePreviewWindow()
  72.             btnSave.Enabled = False
  73.             btnStop.Enabled = False
  74.             btnStart.Enabled = True
  75.             If sfdImage.ShowDialog = Windows.Forms.DialogResult.OK Then
  76.                 BMAP.Save(sfdImage.FileName, Imaging.ImageFormat.Bmp)
  77.             End If
  78.         End If
  79.     End Sub
  80.  
  81.  Private Sub ClosePreviewWindow()
  82.         SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)
  83.         DestroyWindow(hHwnd)
  84.  
  85.     End Sub
  86.  
  87.   Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
  88.         OpenPreviewWindow()
  89.         btnStart.Enabled = False
  90.         btnStop.Enabled = True
  91.  
  92.     End Sub
  93.  
  94. Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
  95.         ClosePreviewWindow()
  96.         btnStart.Enabled = True
  97.         btnStop.Enabled = False
  98.  
  99.     End Sub
  100.  
  101. End Class
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement