درس تشغيل ملف صوت MP3 في الاكسس

[SEMO.Pa3x]

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

كنت قد طرحت سابقا موضوع لتشغيل ملفات الصوت في الاكسس

وكان الموضوع يتناول تشغيل الملفات التي تكون بصيغة WAV حصرا

 

رابط الموضوع:

 

 

درس اليوم هو حول تشغيل ملفات الصوت بصيغة MP3 في الاكسس.

 

الدوال المستخدمة:

mciSendStringA

GetShortPathNameA

 

بعض الحقوق لأصحابها

اتمنى منكم الدعاء لي ولوالدي.

حسنين

Mp3Sounds_SEMO_Pa3x.accdb

تم تعديل مايو 2, 2019 بواسطه SEMO.Pa3x

[jjafferr]

وعليكم السلام اخوي حسنين 🙂

 

ضعنا بين الدروس ومختلف الاكواد 

اعمل فينا خير ، واجمع كود الموضوعين في كود واحد ،

وخلي الكود يقرأ صيغة الملف المطلوب تشغيله ، ثم يشغله بالكود المناسب ،

واذا صيغة الملف غير عن wav او mp3 ، فخلي البرنامج الافتراضي يشغله 🙂

 

وخلي الكود في الموضوع ، وبطريقة مناداة الدوال ، وبمثال مرفق 🙂

 

جعفر

[SEMO.Pa3x]

7 ساعات مضت, jjafferr said:

وعليكم السلام اخوي حسنين 🙂

 

ضعنا بين الدروس ومختلف الاكواد 

اعمل فينا خير ، واجمع كود الموضوعين في كود واحد ،

وخلي الكود يقرأ صيغة الملف المطلوب تشغيله ، ثم يشغله بالكود المناسب ،

واذا صيغة الملف غير عن wav او mp3 ، فخلي البرنامج الافتراضي يشغله 🙂

 

وخلي الكود في الموضوع ، وبطريقة مناداة الدوال ، وبمثال مرفق 🙂

 

جعفر

 

اهلاً معلمي الغالي, تلبية لطلبك الكريم

قمت بجمع الطريقتين بملف واحد اذا وضعت مسار ملف صوت MP3 او WAV فهو سيقوم بفلترة المدخلات وتشغيلها حسب صيغتها.

 

Option Compare Database


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 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

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
Dim Play, a

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

Private Sub DoStartSound_Click()

If IsNull(SoundPath) Then
MsgBox "! áã ÊÞã ÈæÖÚ ãÓÇÑ ãáÝ ÇáÕæÊ", vbCritical, "ÚãáíÉ ÎÇØÆÉ"
Exit Sub
End If

Dim Fix_Path As String
Fix_Path = Mid(SoundPath, 2)

Dim Rev_Extension As String
Rev_Extension = FExtOnly(Fix_Path)

If IsFile(Fix_Path) = False Then
MsgBox "! áã íÊã ÇáÚËæÑ Úáì ÇáãáÝ", vbCritical, "ÚãáíÉ ÎÇØÆÉ"
Exit Sub
End If

Select Case Rev_Extension

Case "mp3"
Sound_MP3 (Fix_Path)
Case "wav"
PlaySound Fix_Path, vbNull, SND_ALIAS Or SND_NODEFAULT Or SND_ASYNC Or SND_LOOP
End Select

Debug.Print Fix_Path
End Sub

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



Function FExtOnly( _
ByVal filename As String) _
As String
Dim nopath As String
Dim dpos As Long
Dim spos As Long
spos = InStrRev(filename, "\")
If spos > 0 Then
nopath = Mid(filename, spos + 1)
Else
nopath = filename
End If
dpos = InStrRev(nopath, ".")
If dpos > 0 Then
FExtOnly = Mid(nopath, dpos + 1)
Else
FExtOnly = ""
End If
End Function



Private Sub DoStopSound_Click()
Dim Fix_Path As String
Fix_Path = Mid(SoundPath, 2)

Dim Rev_Extension As String
Rev_Extension = FExtOnly(Fix_Path)

Select Case Rev_Extension

Case "mp3"
Stop_MP3 (Fix_Path)
Case "wav"
PlaySound vbNullString, ByVal 0&, SND_NODEFAULT
End Select
End Sub

 

حسنين

MP3_WAV_Player_SEMO_Pa3x.accdb

تم تعديل مايو 2, 2019 بواسطه SEMO.Pa3x