تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[VB.NET] معرفة اسم الكاميرا المتصله بالحاسوب (Cam Device)(تم الحل )
#1
السلام عليكم

اخواني انا استخدمت كود حملته من الانترنت يقوم بتصوير الكام باستخدام مكتبة directshow والكود شغال تمام ولكن لحد الان ما اقدرت اعرف كيف ممكن احدد اسماء الكام المتصله بالجهاز واختيار كام معينه للتصوير .

الكود :
كود :
Imports DirectShowLib
Imports System
Imports System.Diagnostics
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Runtime.InteropServices.ComTypes

Public Class Form1

   Dim D As Integer = Convert.ToInt32("0X8000", 16)
   Public WM_GRAPHNOTIFY As Integer = D + 1

   Dim VideoWindow As IVideoWindow = Nothing
   Dim MediaControl As IMediaControl = Nothing
   Dim MediaEventEx As IMediaEventEx = Nothing
   Dim GraphBuilder As IGraphBuilder = Nothing
   Dim CaptureGraphBuilder As ICaptureGraphBuilder2 = Nothing

   Enum PlayState
       Stopped
       Paused
       Running
       Init
   End Enum
   Dim CurrentState As PlayState = PlayState.Stopped

   Dim rot As DsROTEntry = Nothing

   Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs)
       closeinterfaces()
   End Sub

   Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
       MediaControl.Stop()
   End Sub

   Private Sub Form1_FormClosing1(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
       MediaControl.Stop()
   End Sub

   Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
       CaptureVideo()
       PictureBox1.Visible = True

   End Sub

   Private Sub CaptureVideo()
       Dim hr As Integer = 0
       Dim sourceFilter As IBaseFilter = Nothing
       Try
           GetInterfaces()

           hr = CaptureGraphBuilder.SetFiltergraph(GraphBuilder) 'Specifies filter graph "graphbuilder" for the capture graph builder "captureGraphBuilder" to use.

           sourceFilter = FindCaptureDevice()
       
           hr = GraphBuilder.AddFilter(sourceFilter, "Video Capture")

           hr = CaptureGraphBuilder.RenderStream(PinCategory.Preview, MediaType.Video, sourceFilter, Nothing, Nothing)

           Marshal.ReleaseComObject(sourceFilter)

           SetupVideoWindow()

           rot = New DsROTEntry(GraphBuilder)

           hr = MediaControl.Run()

           CurrentState = PlayState.Running

       Catch ex As Exception
           MessageBox.Show("An unrecoverable error has occurred.With error : " & ex.ToString)
       End Try
   End Sub

   Private Sub GetInterfaces()
       Dim hr As Integer = 0
       GraphBuilder = CType(New FilterGraph, IGraphBuilder)
       CaptureGraphBuilder = CType(New CaptureGraphBuilder2, ICaptureGraphBuilder2)
       MediaControl = CType(GraphBuilder, IMediaControl)
       VideoWindow = CType(GraphBuilder, IVideoWindow)
       MediaEventEx = CType(GraphBuilder, IMediaEventEx)
       hr = MediaEventEx.SetNotifyWindow(Me.Handle, WM_GRAPHNOTIFY, IntPtr.Zero) 'This method designates a window as the recipient of messages generated by or sent to the current DirectShow object
   End Sub

   Public Function FindCaptureDevice() As IBaseFilter

       Dim hr As Integer = 0
       Dim classEnum As IEnumMoniker = Nothing
       Dim moniker As IMoniker() = New IMoniker(0) {}
       Dim source As Object = Nothing
       Dim devEnum As ICreateDevEnum = CType(New CreateDevEnum, ICreateDevEnum)
       hr = devEnum.CreateClassEnumerator(FilterCategory.VideoInputDevice, classEnum, 0)

       Marshal.ReleaseComObject(devEnum)
       If classEnum Is Nothing Then
           Throw New ApplicationException("No video capture device was detected.\r\n\r\n" & _
                          "This sample requires a video capture device, such as a USB WebCam,\r\n" & _
                         "to be installed and working properly.  The sample will now close.")
       End If

       If classEnum.Next(moniker.Length, moniker, IntPtr.Zero) = 0 Then
           Dim iid As Guid = GetType(IBaseFilter).GUID
           moniker(0).BindToObject(Nothing, Nothing, iid, source)
       Else
           Throw New ApplicationException("Unable to access video capture device!")
       End If
       Marshal.ReleaseComObject(moniker(0))
       Marshal.ReleaseComObject(classEnum)

       Return CType(source, IBaseFilter)

   End Function

   Public Sub SetupVideoWindow()
       Dim hr As Integer = 0
       'set the video window to be a child of the main window
       'putowner : Sets the owning parent window for the video playback window.
       hr = VideoWindow.put_Owner(PictureBox1.Handle) 'Me.Handle)
       PictureBox1.Visible = False

       hr = VideoWindow.put_WindowStyle(WindowStyle.Child Or WindowStyle.ClipChildren)

       'Use helper function to position video window in client rect of main application window
       ResizeVideoWindow()

       'Make the video window visible, now that it is properly positioned
       'put_visible : This method changes the visibility of the video window.
       hr = VideoWindow.put_Visible(OABool.True)

   End Sub

   Public Sub ResizeVideoWindow()
       'Resize the video preview window to match owner window size
       'left , top , width , height
       If Not (VideoWindow Is Nothing) Then 'if the videopreview is not nothing
           VideoWindow.SetWindowPosition(0, 0, Me.Width, Me.ClientSize.Height)
       End If
   End Sub

   Public Sub closeinterfaces()
       '//stop previewing data
       If Not (Me.MediaControl Is Nothing) Then
           Me.MediaControl.StopWhenReady()
       End If

       Me.CurrentState = PlayState.Stopped

       '//stop recieving events
       If Not (Me.MediaEventEx Is Nothing) Then
           Me.MediaEventEx.SetNotifyWindow(IntPtr.Zero, WM_GRAPHNOTIFY, IntPtr.Zero)
       End If

       '// Relinquish ownership (IMPORTANT!) of the video window.
       '// Failing to call put_Owner can lead to assert failures within
       '// the video renderer, as it still assumes that it has a valid
       '// parent window.
       If Not (Me.VideoWindow Is Nothing) Then
           Me.VideoWindow.put_Visible(OABool.False)
           Me.VideoWindow.put_Owner(IntPtr.Zero)
       End If

       ' // Remove filter graph from the running object table
       If Not (rot Is Nothing) Then
           rot.Dispose()
           rot = Nothing
       End If

       '// Release DirectShow interfaces
       Marshal.ReleaseComObject(Me.MediaControl) : Me.MediaControl = Nothing
       Marshal.ReleaseComObject(Me.MediaEventEx) : Me.MediaEventEx = Nothing
       Marshal.ReleaseComObject(Me.VideoWindow) : Me.VideoWindow = Nothing
       Marshal.ReleaseComObject(Me.GraphBuilder) : Me.GraphBuilder = Nothing
       Marshal.ReleaseComObject(Me.CaptureGraphBuilder) : Me.CaptureGraphBuilder = Nothing

   End Sub

   Private Sub btnGrab_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
       GrabImage()
   End Sub

 

 

 
   Public Sub GrabImage()
       Try
           MediaControl.Pause()
           Dim bmp As New Bitmap(PictureBox1.Width, PictureBox1.Height)
           Using g As Graphics = Graphics.FromImage(bmp)
               Dim pt As Point = PictureBox1.PointToScreen(New Point(0, 0))
               g.CopyFromScreen(pt.X, pt.Y, 0, 0, bmp.Size)
           End Using
           PictureBox2.Image = bmp
           bmp.Save("D:\cam1\1.bmp")
           MediaControl.Run()
       Catch
       End Try
   End Sub

 
   Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
       GrabImage()
   End Sub

   Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
       MediaControl.Stop()
   End Sub

   Private Sub Button3_Click(sender As Object, e As EventArgs)

   End Sub
End Class

بالكود موجود function  اسمه FindCaptureDevice حاولت احلله بس ما عرفت افهمه لانه مرتبط بمكتبة directshow

وحملت السورس بالمرفقات 


الملفات المرفقة
.rar   cam1.rar (الحجم : 308.3 ك ب / التحميلات : 13)
الرد }}}}
تم الشكر بواسطة:
#2
كود :
Dim capDevices As DsDevice() = DsDevice.GetDevicesOfCat(FilterCategory.VideoInputDevice)
       Dim dvcList As New List(Of String)
       For Each cd As DsDevice In capDevices
           MsgBox(cd.Name)
       Next

تم الحل بحمد الله بعد البحث الكثير وجدت لدي مثال قد قمت بتحميله السنة الماضية في المنتدى عن الكام وقد وجدت فيه الحل مع ان الحل لم يكن ظاهرا مباشرة الا بعد تحليل الكود وبفضل الله قبل كل شيء 


تركت الكود ليستفيد باقي الاعضاء 


شكرا لكم  Big Grin Big Grin
الرد }}}}
تم الشكر بواسطة:


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [VB.NET] رسم بالحاسوب طريقه رسم نجمه مٌحُمٌدِ الُ ظٌُهرَُه 2 86 25-11-16, 04:34 PM
آخر رد: مٌحُمٌدِ الُ ظٌُهرَُه
  [VB.NET] سؤال كيف يمكن معرفة التغير في قاعدة البيانات وليد الزنتاني 2 117 10-11-16, 01:20 AM
آخر رد: وليد الزنتاني
  معرفة الاشخاص المتصلين بقاعدة البيانات في الشبكة المحلية ببساطة مثل مقاهي الانترنت thevirus 2 125 29-10-16, 06:25 PM
آخر رد: thevirus
Lightbulb المساعدة في معرفة طريقة كتابة الأكواد بشكل صحيح ... Arabia 0 73 26-10-16, 03:18 PM
آخر رد: Arabia
  مشكلة في هذا الكود كيف الحل abumuhannadzym 3 94 18-10-16, 12:45 AM
آخر رد: abumuhannadzym
  معرفة عدد صفوف الداتا جريد فيو %Eman% 2 115 15-09-16, 05:23 PM
آخر رد: %Eman%
  [سؤال] معرفة نوع البيانات محمد بن عطية 2 108 15-08-16, 12:05 PM
آخر رد: محمد بن عطية
  [سؤال] السلام عليكم هل استطيع الحصول على كود في الفيجول بيزك 6 استطيع كتابة الحل المركب للمع hafezshaban 0 96 13-07-16, 02:21 AM
آخر رد: hafezshaban
  [سؤال] كيفية معرفة ترتيب اليوم فى السنة نور الدين وليد 11 346 20-06-16, 07:54 PM
آخر رد: aliday03
  [سؤال] طلب كود معرفة كام شخص فاتح البرنامج mostfa1995 4 294 14-04-16, 03:25 AM
آخر رد: mostfa1995

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم