[3booody]

عليكم السلام ورحمة الله وبركاته

للأمانة العلمية هذا الكود منذ زمن بعيد كان لشخص بالمنتدى ولا اتذكر اسم الاخ وانا قمت بالتعديل عليه بحيث اضفت احداث للفئة

كود :

Public Class MediaPlayer
   Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
   Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Integer, ByVal lpstrBuffer As String, ByVal uLength As Integer) As Integer

   Public Event MediaOpened(ByVal sender As System.Object, ByVal e As System.EventArgs)
   Public Event MediaClosed(ByVal sender As System.Object, ByVal e As System.EventArgs)
   Public Event MediaPosition(ByVal sender As Object, ByVal e As Long)

   Dim WithEvents tim As New Timer With {.Interval = 1}

   Private Shared ObjectCount As Integer = 0
   Private retVal As Integer = 0
   Private returnData As String = Space(128)
   Private errorString As String = Space(128)
   Private errorSuccess As Boolean

   '
   Sub New()
       ObjectCount = ObjectCount + 1
       mFileAlias = "SND" & Hex(Now.Ticks) & Hex(ObjectCount)
   End Sub

   Sub New(ByVal pFileName As String)
       Me.New()
       Me.FileName = pFileName
   End Sub


   Private mFileAlias As String
   ReadOnly Property FileAlias() As String
       Get
           Return mFileAlias
       End Get
   End Property

   Private mFileName As String
   Property FileName() As String
       Get
           Return mFileName
       End Get
       Set(ByVal value As String)
           Me.Stop()
           Me.close()
           mFileName = value
       End Set
   End Property

   Private mLength As Long = 0
   Public ReadOnly Property Length() As Long
       Get
           Return mLength
       End Get
   End Property

   Public Property Position() As Long
       Get
           retVal = mciSendString("status " & Me.FileAlias & " position", returnData, 128, 0)
           Return Val(returnData)
       End Get
       Set(ByVal value As Long)
           If Me.IsPlaying() Then
               retVal = mciSendString("play " & Me.FileAlias & " from " & value.ToString, 0, 0, 0)
           Else
               retVal = mciSendString("seek " & Me.FileAlias & " to " & value.ToString, 0, 0, 0)
           End If
       End Set
   End Property


   Public ReadOnly Property IsPlaying() As Boolean
       Get
           retVal = mciSendString("status " & Me.FileAlias & " mode", returnData, 128, 0)
           Return returnData.StartsWith("playing")
       End Get
   End Property


   Private mVolume As Byte = 100
   Public Property volume() As Byte
       Get
           Return mVolume
       End Get
       Set(ByVal value As Byte)
           If value > 100 Then
               value = 100
           End If
           mVolume = value

           Dim vol As Integer = (Me.volume * 10)
           retVal = mciSendString("setaudio " & Me.FileAlias & " volume to " & vol.ToString, 0, 0, 0)

       End Set
   End Property

   Private mIsOpen As Boolean = False
   Sub open(ByVal sFileName As String)
       Me.FileName = sFileName
       Me.open()
   End Sub

   Public ScreenHandel As Int32 = 0

   Sub open()
       Me.close()
       If ScreenHandel <= 0 Then
           retVal = mciSendString("open """ & Me.FileName & """ type mpegvideo alias " & Me.FileAlias, 0, 0, 0)
       Else
           retVal = mciSendString("open """ & Me.FileName & """ type mpegvideo alias " & Me.FileAlias & " parent " & ScreenHandel.ToString & " style " & "child" & " ", 0, 0, 0)
       End If

       retVal = mciSendString("set " & Me.FileAlias & " time format ms", 0, 0, 0)

       retVal = mciSendString("status " & Me.FileAlias & " length", returnData, 128, 0)
       mLength = Val(returnData)
       mIsOpen = True
       Me.volume = Me.volume
       RaiseEvent MediaOpened(Me, New System.EventArgs)
       tim.Start()
   End Sub

   Sub Play(Optional ByVal repate As Boolean = False)
       If repate = True Then
           Me.Play("repeat")
       Else
           Play("")
       End If
   End Sub


   Sub Play(ByVal pFileName As String, ByVal pRepate As Boolean)
       Me.FileName = pFileName
       Me.Play(pRepate)
   End Sub

   Sub Play(ByVal pCommand As String)
       Dim Cmd As String = "play " & Me.FileAlias & " " & pCommand
       If mIsOpen = False Then
           Me.close()
           Me.open()
       End If
       retVal = mciSendString(Cmd, 0, 0, 0)
   End Sub


   Sub Pause()
       retVal = mciSendString("pause " & Me.FileAlias, 0, 0, 0)
   End Sub


   Sub [resume]()
       retVal = mciSendString("resume " & Me.FileAlias, 0, 0, 0)
   End Sub

   Sub [Stop]()
       retVal = mciSendString("stop " & Me.FileAlias, 0, 0, 0)
   End Sub


   Sub close()
       Me.Stop()
       retVal = mciSendString("close " & Me.FileAlias, 0, 0, 0)
       '----------------------------------
       If mIsOpen = True Then
           RaiseEvent MediaClosed(Me, New System.EventArgs)
           tim.Stop()
       End If
       '----------------------------------
       mIsOpen = False
       mLength = 0
       '--------------------------------------
   End Sub

   Private Sub tim_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles tim.Tick
       RaiseEvent MediaPosition(Me, Me.Position)
   End Sub
End Class

واذا واجهت مشكلة فيه عندي مشروع متكامل عملته عليه
بالتوفيق الك اخي