playsound شخابيط : طريقة /اضافة صوت للاكسس مع التحكم فى (الايقاف/التشغيل) للصوت

[ابو جودي]

-تجهيز مجلدات وملف الصوت 
الخطوة الاولى قم بانشاء مجلد جديد فى مسار قاعدة البيانات الحالى باسم ( Resurce )
الخطوة الثانية قم بفتح المجلد السابق وقم بانشاء مجلد جديد بداخله باسم ( Audio Files )
الخطوة الثالثة قم بنسخ ملف صوت الى المجلد ( Audio Files ) اما بامتداد  wav  ,  .mp3.

---------------------
-تجهيز قاعدة البيانات 
الخطوة الاولى قم بانشاء وحدة نمطية باسم  ( modPlayAudio )  وقم بلصق الاكواد الاتية فى هذه الوحدة النمطية

Option Compare Database
Option Explicit

#If VBA7 And Win64 Then
 Private 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
 Private Declare PtrSafe Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
 Private Declare PtrSafe Function playSound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
#Else
 Private Declare 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
 Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long
 Private Declare Function playSound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
#End If

Const SND_ALIAS_SYSTEMASTERISK      As String = "SystemAsterisk"
Const SND_ALIAS_SYSTEMDEFAULT       As String = "SystemDefault"
Const SND_ALIAS_SYSTEMEXCLAMATION   As String = "SystemExclamation"
Const SND_ALIAS_SYSTEMEXIT          As String = "SystemExit"
Const SND_ALIAS_SYSTEMHAND          As String = "SystemHand"
Const SND_ALIAS_SYSTEMQUESTION      As String = "SystemQuestion"
Const SND_ALIAS_SYSTEMSTART         As String = "SystemStart"
Const SND_ALIAS_SYSTEMWELCOME       As String = "SystemWelcome"
Const SND_ALIAS_YouGotMail          As String = "MailBeep"

' playsound Params
Const SND_LOOP = &H8
Const SND_ALIAS = &H10000
Const SND_NODEFAULT = &H2 ' silence if no sound associated with event
Const SND_ASYNC = &H1 ' play async (don't freeze program while sound is playing)
Private sMusicFile As String

Public soundOn As Boolean

Dim mp3Path   As String
Dim wavPath   As String
Dim Play      As Variant

Public Sub Sound_MP3(ByVal File$)
  sMusicFile = GetShortPath(File)
  Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
  If Play <> 0 Then
  End If
End Sub

Public Sub Stop_MP3(Optional ByVal FullFile$)
  Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub

Public Function GetShortPath(ByVal strFileName As String) As String
  Dim lngRes As Long, strPath As String
  strPath = String$(165, 0)
  lngRes = GetShortPathName(strFileName, strPath, 164)
  GetShortPath = Left$(strPath, lngRes)
End Function

Function IsFile(ByVal fName As String) As Boolean
  On Error Resume Next
  IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function

Public Function AudioFilePath() As String
  AudioFilePath = CurrentProject.Path & "\Resurce\Audio Files\"
End Function

Public Function PlayFile(ByVal FileName_ As String)

Dim Msg       As String

Msg = ChrW(1578) & ChrW(1571) & ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & ChrW(1608) & ChrW(1580) & _
      ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1587) & ChrW(1575) & ChrW(1585) & ChrW(32) & ChrW(40) & ChrW(32) & _
      ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(32) & ChrW(47) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & _
      ChrW(1578) & ChrW(41) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(46) & _
      ChrW(13) & ChrW(10) & ChrW(1578) & ChrW(1571) & ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & _
      ChrW(1608) & ChrW(1580) & ChrW(1608) & ChrW(1583) & ChrW(32) & ChrW(40) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & _
      ChrW(32) & ChrW(47) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & ChrW(1578) & ChrW(41) & ChrW(32) & _
      ChrW(1575) & ChrW(1604) & ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(1601) & ChrW(1609) & ChrW(32) & ChrW(1575) & _
      ChrW(1604) & ChrW(1605) & ChrW(1587) & ChrW(1575) & ChrW(1585) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(1605) & _
      ChrW(1581) & ChrW(1583) & ChrW(1583) & ChrW(32) & ChrW(46) & ChrW(13) & ChrW(10) & ChrW(1578) & ChrW(1571) & _
      ChrW(1603) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1606) & ChrW(32) & ChrW(1575) & ChrW(1587) & ChrW(1605) & _
      ChrW(32) & ChrW(32) & ChrW(40) & ChrW(32) & ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(32) & ChrW(47) & ChrW(32) & _
      ChrW(1605) & ChrW(1604) & ChrW(1601) & ChrW(1575) & ChrW(1578) & ChrW(41) & ChrW(32) & ChrW(1575) & ChrW(1604) & _
      ChrW(1589) & ChrW(1608) & ChrW(1578) & ChrW(32) & ChrW(46)

  mp3Path = AudioFilePath & FileName_ & ".mp3"
  wavPath = AudioFilePath & FileName_ & ".wav"
  StopFile

  If IsFile(mp3Path) Then Sound_MP3 (mp3Path): Exit Function
  If IsFile(wavPath) Then playSound (wavPath), vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC: Exit Function
  If IsFile(mp3Path) = IsFile(wavPath) Then MsgBox (Msg), vbOKOnly + vbMsgBoxRtlReading + vbMsgBoxRight: Exit Function
End Function

Public Function StopFile()
  playSound vbNullString, ByVal 0&, SND_NODEFAULT
  Stop_MP3 (mp3Path)
End Function

الخطوة الثانية قم بانشاء نموذج باسم  ( frmPlayAudio ) 

الخطوة الثالثة قم بانشاء مربع نص فى النموذج السابق باسم  ( txtAudioFileName ) 

الخطوة الرابعة قم بانشاء زر أمر فى النموذج السابق باسم  ( cmdPlay )  وفى حدث عند النقر ضع الكود الاتى
 

  soundOn = True: PlayFile (Me.txtAudioFileName)

الخطوة الخامسة قم بانشاء زر أمر فى النموذج السابق باسم  ( cmdStop )   وفى حدث عند النقر ضع الكود الاتى

  StopFile

 الخطوة السادسة فى حدث عند إغلاق النموذج ضع الكود الاتى

  StopFile

الخطوة السابعة بعد حفظ ما سبق افتح النموذج وادخل فى مربع النص ( txtAudioFileName  ) اسم ملف الصوت الموجود فى المسار المحدد بدون الامتداد

مثلا لو ملف الصوت باسم :     MyAudio.mp3      Or    MyAudio.wav
اسم ملف الصوت فى مربع النص ( txtAudioFileName ) يكون فى الشكل الاتى فقط :  MyAudio

والان جرب الضغط على زر الامر الخاص بالتشغيل تارة وزر الامر الخاص بالايقاف تارة أخرى 

 

طيب ملاحظة مهمه :
الطريقة ودوال API  هنا تقوم بتشغيل ملفات صوت من النوعين  MP3 . WAV <<---<  والله دلع شغل فاخر من الأخر
تم صياغة الكود بمرونه مطلقة للتعامل مع الملف بغض النظر عن امتداد الملف  اه والله زيمبئولك كده مش مصدق ليه مش بئولك شغل فاخر
اللى مش عاجبه المسار لملفات الصوت او عاوز يغير مكانها او اسمها طبعا فى الموديول يغير فى الروتين ده على مزاجه
 

AudioFilePath()

 

انا شرحت بالتفصيل الممل اياك  حد يقول لى عاوز مرفق أو مش عارف يطبق الشرح

 

 

[ابو جودي]

لم اجد تفاعل أو اى رد يدل على نجاح فاعلية التطبيق والتجربة 

وهذه القواعد للتجربة

تم مراعاة عند كتابة الأكواد العمل على كل من النواتان    32x , 64x

استاذى الجليل الاستاذ @Moosak  اردت فقط الاطمئنان على المكتبة العامرة  

Moh3sam.zip

[Moosak]

بسم الله ما شاء الله .. تبارك الرحمن 😄🖐🏼️

شغل معلمين بجد .. 😊

الله يبارك لك في عمرك وعلمك وصحتك وذريتك 🤲🏻

أنا كنت عارف أن قلبك مش هيسيبك تدينا الكود وتمشي 😅

اشتغلت معايه زي السكينة على الحلاوة ما شاء الله .. 👍🏼

أيش رايك لو تضيف زر إيقاف مؤقت ⏸ للمجموعة وتكتمل النعمة ؟  

                                  

  

منذ ساعه, ابو جودي said:

استاذى الجليل الاستاذ @Moosak  اردت فقط الاطمئنان على المكتبة العامرة 

والمكتبة بتسلم عليك 😂

 

 

[ابو جودي]

21 ساعات مضت, Moosak said:

أيش رايك لو تضيف زر إيقاف مؤقت ⏸ للمجموعة وتكتمل النعمة ؟  

 

والله أعلى وأعلم على قدر معلوماتى للاسف PlaySound API  الخاصة بتشغيل ملفات صوت ذات الامتداد WAV  لا تدعم الإيقاف المؤقت/الاستئناف وننتظر من اساتذتنا أهل الخبرة مراجعتنا فى هذه النقطة إن أمكن 

 

وهذا تعديل بسيط علشان خاطر عيونك تدلل

PlayAudio V0.2.zip

[at_aziz]

بارك الله فيك وجزاك الله خير   استاذنا الفاضل ابا جودي

مثال رائع ومفيد جدا

وفقك الله

[ابو جودي]

في 20‏/9‏/2023 at 01:44, at_aziz said:

بارك الله فيك وجزاك الله خير   استاذنا الفاضل ابا جودي

مثال رائع ومفيد جدا

وفقك الله

جزاكم الله خيرا 

[AlwaZeeR]

جميل ابا جودي 

دائماً تتحفنا بما هو جديد ورائع

حبذا لو تضيف زر التالي والسابق 

::

تحياتي

[ابو جودي]

في 29‏/9‏/2023 at 10:43, AlwaZeeR said:

حبذا لو تضيف زر التالي والسابق 

 

اعتذر عن تأخرى فى الرد على استاذى الجليل ومعلمى القدير 

العفو منكم استاذى انا طويلب علم ينهل من ربوع وانهار وفيض علمكم الوفير 

وتحت امر حضرتك من عيونى  طلبات حضرتك أوامر

[Moosak]

في 17‏/9‏/2023 at 19:31, Moosak said:

أيش رايك لو تضيف زر إيقاف مؤقت ⏸ للمجموعة وتكتمل النعمة ؟  

@ابو جودي

وطويلب العلم ده .. طلباته مش أوامر برده ولا أييييييه ؟؟  😅💪🏻

[ابو جودي]

6 دقائق مضت, Moosak said:

@ابو جودي

طلباته مش أوامر برده ولا أييييييه ؟؟  😅💪🏻

أكيد طبعا أوامر يا أفندم 

بس هو أنت مأخدتش بالك إن أوامر حضرتك إتنفذت واللا إيه 
 

قبل ما تدخل تزعق لى 😡

بص ع المشاركة دى كده 👇

في 18‏/9‏/2023 at 00:39, ابو جودي said:

والله أعلى وأعلم على قدر معلوماتى للاسف PlaySound API  الخاصة بتشغيل ملفات صوت ذات الامتداد WAV  لا تدعم الإيقاف المؤقت/الاستئناف وننتظر من اساتذتنا أهل الخبرة مراجعتنا فى هذه النقطة إن أمكن 

 

وهذا تعديل بسيط علشان خاطر عيونك تدلل

PlayAudio V0.2.zip 4.93 \u0645\u064a\u062c\u0627 \u0628\u0627\u064a\u062a · 98 downloads

[Moosak]

20 دقائق مضت, ابو جودي said:

هو أنت مأخدتش بالك إن أوامر حضرتك إتنفذت واللا إيه 

آآآآآآه فعلا 🙈

سبحان الله ما شفتهاش ..  لا مواخذه شكلي كان مغمى عليه  😂 🏃🏻‍♂️🏃🏻‍♂️🏃🏻‍♂️