تشغيل الاصوات مع الفورم

تشغيل الصوت عند تشغيل البرنامج وكذلك عملية تشغيله وأيقافه عن طريق الضغط على command button .
كل مانحتاج الفورم وcommand button عدد 2 واحد أسمه cmdMusicStart والأخر cmdMusicStop ، وكذلك الموجل.

_______ ضع هذا الكود في الفورم _________

Option Explicit

Private Sub cmdMusicStart_Click()
mci "play bg_music from 0"
End Sub

Private Sub cmdMusicStop_Click()
mci "stop bg_music"
End Sub



Private Sub Form_Load()
Dim Music As Boolean
Dim Sound1 As Boolean, Sound2 As Boolean
Music = LoadMedia("C:\Windows\Media\town.mid", "bg_music", "sequencer")

If Music Then mci "play bg_music"
cmdMusicStart.Enabled = Music
cmdMusicStop.Enabled = Music

End Sub

Private Sub Form_Terminate()
mci "close bg_music", 0

End Sub

_______ ضع هذا الكود في الموجل ___________

Option Explicit

'constant for allocating space for return strings
'increase if end of strings is getting ignored
'however 1K should be sufficient in all cases
Public Const ALLOC_SPACE = 1024

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, Optional ByVal lpstrReturnString As String = "", Optional ByVal uReturnLength As Long = 0, Optional ByVal hwndCallback As Long = 0) As Long
Public Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

'calls mciSendString and converts C-style returned string
'to a VB one, and does basic error handling
Public Function mci(ByVal Command As String, Optional ByRef ErrorReturn As Variant) As String
Dim Ret As String, MciErr As Long, I As Integer
Ret = String(ALLOC_SPACE, vbNullChar)
MciErr = mciSendString(Command, Ret, ALLOC_SPACE)
If MciErr <> 0 And IsMissing(ErrorReturn) Then RaiseMciError (MciErr)
If Not IsMissing(ErrorReturn) Then ErrorReturn = MciErr
'String returned will be null-terminated
I = InStr(Ret, vbNullChar)
If I Then
Ret = Left(Ret, I - 1)
End If
mci = Trim(Ret)
End Function

'calls mciGetErrorString and converts the C string to a VB
'one, removing null-terminator, etc
Public Function MciError(ErrCode As Long) As String
Dim Ret As String, I As Integer
'allocate space for error code
Ret = String(ALLOC_SPACE, vbNullChar)
mciGetErrorString ErrCode, Ret, 1024
'String returned will be null-terminated
I = InStr(Ret, vbNullChar)
If I Then
Ret = Left(Ret, I - 1)
End If
MciError = Trim(Ret)
End Function

'This is seperate so it can be called from other code,
'if you want to trap errors, but get unexpected ones,
'like as used in LoadMedia
Public Sub RaiseMciError(ByVal Code As Long)
If Code = 0 Then Exit Sub
Err.Raise Code, "winmm.dll", MciError(Code)
End Sub

'due to how common this is, and the amount of code required
'this is implemented here as a function
'returns true if loaded ok, false if not found
Public Function LoadMedia(ByVal Filename As String, ByVal Alias As String, ByVal DeviceType As String) As Boolean
Dim MciErr As Variant
mci "open """ & Filename & """ type " & DeviceType & " alias " & Alias, MciErr
Select Case MciErr
Case 0
LoadMedia = True
Case 275 'cannot find it
LoadMedia = False
Case 289 'alias in use
mci "close " & Alias
'try again
LoadMedia = LoadMedia(Filename, Alias, DeviceType)
Case Else
RaiseMciError MciErr
End Select
End Function