'Beispiel: VB .Net - Webcam ansprechen - Video anzeigen - Aktuelles Bild in die Zwischenablage kopieren und anzeigen. ' Option Explicit On Option Strict On Public Class Form1 Private w32 As Win32Api Private Shadows [Handle] As IntPtr Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles Button1.Click w32 = New Win32Api(Me.PictureBox1.Handle, 352, 287) [Handle] = w32.GetCaptureHandle Me.Button1.Enabled = False If Not [Handle].Equals(IntPtr.Zero) Then Me.Button3.Enabled = True Me.Button2.Enabled = True End If End Sub Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) _ Handles Me.FormClosing w32.MyHandle = [Handle] If Not [Handle].Equals(IntPtr.Zero) Then w32.DisposeConnection() End If End Sub Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles Button2.Click w32.MyHandle = [Handle] If Not [Handle].Equals(IntPtr.Zero) Then w32.DisposeConnection() Me.Button1.Enabled = True Me.Button3.Enabled = False Me.Button2.Enabled = False End If End Sub Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles Button3.Click If Not [Handle].Equals(IntPtr.Zero) Then w32.MyHandle = [Handle] Dim img As Image = w32.GetImage() If img IsNot Nothing Then Me.PictureBox2.Image = img Else MessageBox.Show("Es ist ein Fehler aufgetreten.", "Info") End If End If End Sub Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles MyBase.Load Me.Button3.Enabled = False End Sub Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _ Handles Button4.Click Dim sfd As SaveFileDialog = New SaveFileDialog() With sfd .Title = "Grafik speichern..." .RestoreDirectory = True .InitialDirectory = Application.StartupPath .Filter = "Jpeg (*.jpg)|*.jpg" If .ShowDialog = Windows.Forms.DialogResult.OK Then Dim sitf As SaveImageToFile = New SaveImageToFile(.FileName, Me.PictureBox2.Image) With sitf Dim Result As Boolean = .SaveImage() Select Case Result Case True MessageBox.Show("Datei wurde gespeichert.", "Info") Case Else MessageBox.Show("Datei konnte nicht gespeichert werden.", "Info") End Select End With Else MessageBox.Show("Abbruch...", "Info") End If End With End Sub Public Class SaveImageToFile Private _filename As String Private _img As Image Public Sub New(ByVal Filename As String, ByVal img As Image) If Not String.IsNullOrEmpty(Filename) Then Me._filename = Filename If img IsNot Nothing Then Me._img = img Else Return End If Else Return End If End Sub Public Function SaveImage() As Boolean Try Dim hBitmap As Bitmap = New Bitmap(Me._img) hBitmap.Save(Me._filename, Imaging.ImageFormat.Jpeg) If IO.File.Exists(Me._filename) Then Return True Else Return False End If Catch ex As Exception MessageBox.Show(ex.Message.ToString(), "Info") End Try Return False End Function End Class End Class Public Class Win32Api #Region "Api Functions" Private Declare Auto Function capCreateCaptureWindow 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 Integer, _ ByVal hWnd As IntPtr, _ ByVal nID As Integer) _ As IntPtr Private Declare Auto Function SendMessage Lib "user32.dll" ( _ ByVal hwnd As IntPtr, _ ByVal uMsg As Integer, _ ByVal wParam As Integer, _ ByVal lParam As Integer) _ As Integer #End Region #Region "Constants" Private Const WM_USER As Int32 = &H400 Private Const WS_CHILD As Integer = &H40000000 Private Const WS_VISIBLE As Integer = &H10000000 Private Const WM_CAP_START As Integer = WM_USER Private Const WM_CAP_DRIVER_CONNECT As Integer = (WM_CAP_START + 10) Private Const WM_CAP_SET_PREVIEWRATE As Integer = (WM_CAP_START + 52) Private Const WM_CAP_SET_OVERLAY As Integer = (WM_CAP_START + 51) Private Const WM_CAP_SET_PREVIEW As Integer = (WM_CAP_START + 50) Private Const WM_CAP_DRIVER_DISCONNECT As Integer = (WM_CAP_START + 11) Private Const WM_CAP_EDIT_COPY As Integer = (WM_CAP_START + 30) #End Region #Region "Private" Private _hwnd As IntPtr Private _width As Integer Private _height As Integer #End Region #Region "Camera Id" Private Const CameraId As Integer = 0 #End Region #Region "Frames" Private Const Frames As Integer = 24 #End Region #Region "Positions" Private x As Integer = 0 Private y As Integer = 0 #End Region #Region "Public" Public MyHandle As IntPtr #End Region #Region "Constructor" Public Sub New(ByVal hWnd As IntPtr, ByVal Width As Integer, ByVal Height As Integer) If Not hWnd.Equals(IntPtr.Zero) Then Me._hwnd = hWnd If (Width >= 320) And (Height >= 240) Then Me._width = Width : Me._height = Height Else Return End If Else Return End If End Sub #End Region #Region "Functions" Public Function GetCaptureHandle() As IntPtr Dim [Handle] As IntPtr = Win32Api.capCreateCaptureWindow("CaptureWindow", _ Win32Api.WS_CHILD + Win32Api.WS_VISIBLE, _ x, y, _ Me._width, Me._height, _ Me._hwnd, _ Win32Api.CameraId) SendMessage([Handle], Win32Api.WM_CAP_DRIVER_CONNECT, Win32Api.CameraId, 0) SendMessage([Handle], Win32Api.WM_CAP_SET_PREVIEWRATE, Win32Api.Frames, 0) SendMessage([Handle], Win32Api.WM_CAP_SET_OVERLAY, 1, 0) SendMessage([Handle], Win32Api.WM_CAP_SET_PREVIEW, 1, 0) If Not [Handle].Equals(IntPtr.Zero) Then Return [Handle] Else Return IntPtr.Zero End If End Function Public ReadOnly Property GetImage() As Drawing.Image Get Return Me.SetCurrentImageToClipBoard() End Get End Property Private Function SetCurrentImageToClipBoard() As Drawing.Image Try My.Computer.Clipboard.Clear() SendMessage(Me.SetHandle(), Win32Api.WM_CAP_EDIT_COPY, 0, 0) Dim img As Image = My.Computer.Clipboard.GetImage If img IsNot Nothing Then Return img Else Return Nothing End If Catch Return Nothing End Try End Function Public Property SetHandle() As IntPtr Get Return MyHandle End Get Set(ByVal value As IntPtr) MyHandle = value End Set End Property Public Sub DisposeConnection() Dim result As Integer = SendMessage(Me.SetHandle(), Win32Api.WM_CAP_DRIVER_DISCONNECT, Win32Api.CameraId, 0) Debug.WriteLine("Disconnected: " & result.ToString()) End Sub #End Region End Class