إضافة ملف صوتي في البرنامج عند النقر

[الهمة]

السلام عليكم ورحمة الله وبركاتة أخواني أعضاء منتدى أفيسنا

أرجو المساعدة في إضافة ملف صوتي في البرنامج المرفق حاولت الإضافة لكن تأتي رسالة بأن الجهاز المستخدم 64 bit  الكود لا يعمل فيه

شاكرا لكم تعاونكم 

برنامج جدول الجلسات.rar

[jjafferr]

وعليكم السلام 🙂

 

احنا عادة نتعامل مع اصحاب الهمة ، بس الآن تعاملنا بالهمة شخصيا 🙂

مو علوم خبر 🙂

 

استعمل الوحدة النمطية التالية ، اللي تعمل على النواتين 32بت و 64بت:

Option Compare Database
Option Explicit

  Declare PtrSafe Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" _
    (ByVal filename As String, ByVal snd_async As Long) As Long

  Function PlaySound(sWavFile As String)
    ' Purpose:  Plays a sound.
    ' Argument: the full path and file name.

    If apisndPlaySound(sWavFile, 1) = 0 Then
        MsgBox "The Sound Did Not Play!"
    End If
  End Function

.

ومن النموذج ناديها هكذا :

اذا كان ملف الصوت في نفس ملف البرنامج
Private Sub Form_Current()

    Call PlaySound(Application.CurrentProject.Path & "\ringin.wav")
End Sub

  
او في اي ملف آخر
Private Sub Form_Current()

    Call PlaySound("D:\mySounds\ringin.wav")
End Sub

 

جعفر

Rulesets.zip

[الهمة]

تسلم أخي جعفر راع بلادي على الرد وجزاك الله وخيرا 

اشكرك بعنف وقسوة 

 

[jjafferr]

السلام عليكم 🙂

 

هذا تعديل على المشاركة اعلاه ، وبه تعمل بقية صيغ الصوت مثل wav و mp3 🙂

 

الوحدة النمطية التالية ، تعمل على النواتين 32بت و 64بت:

Option Compare Database
Option Explicit


 Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
  (ByVal lpstrCommand As String, _
   ByVal lpstrReturnString As Any, _
   ByVal uReturnLength As Long, _
   ByVal hwndCallback As Long) As Long
'
' the above API will not work if there is a space in the file path,
' so use the old DOS trick to get a short name path for this file, then play it
'


Function get8_3FullFileName(ByVal sFullFileName As String) As String

'
' Convert the normal path to the old DOS 8.3 path
' this solves the problem of spaces in the path
'
    Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
    get8_3FullFileName = FSO.GetFile(sFullFileName).ShortPath
    
End Function

  
Public Sub PlaySound(SoundFile As String)

    SoundFile = get8_3FullFileName(SoundFile)
    
    If mciSendString("play " & SoundFile, 0&, 0, 0) <> 0 Then
        MsgBox "The Sound Did Not Play!"
    End If
   
End Sub


Public Sub StopSound(SoundFile As String)

    SoundFile = get8_3FullFileName(SoundFile)

    If mciSendString("close " & SoundFile, 0&, 0, 0) <> 0 Then
        MsgBox "Could't stop The Sound!"
    End If
    
End Sub

.

ومن النموذج ناديها هكذا :

اذا كان ملف الصوت في نفس ملف البرنامج
Private Sub Form_Current()

    Call PlaySound(Application.CurrentProject.Path & "\ringin.wav")
    'Call PlaySound(Application.CurrentProject.Path & "\ringin.mp3")
End Sub

  
او في اي ملف آخر
Private Sub Form_Current()

    Call PlaySound("D:\mySounds\ringin.wav")
    'Call PlaySound("D:\mySounds\ringin.mp3")
End Sub

 

جعفر

Play Sound.zip