Nahrßnφ a p°ehrßnφ zvuku

Declare Function mciSendString Lib "winmm.dll" _
                                   Alias "mciSendStringA" _
                                   (ByVal lpstrCommand As String, _ 
                                   ByVal lpstrReturnString As String, _ 
                                   ByVal uReturnLength As Long, _
                                   ByVal hwndCallback As Long) As Long

Declare Function mciGetErrorString Lib "winmm.dll" _ 
                                   Alias "mciGetErrorStringA" _ 
                                   (ByVal dwError As Long, _ 
                                   ByVal lpstrBuffer As String, _ 
                                   ByVal uLength As Long) As Long

Sub CloseSound()

    Dim Result&
    Dim errormsg%
    Dim ReturnString As String * 1024
    Dim ErrorString As String * 1024

    Result& = mciSendString("close mysound", ReturnString, 1024, 0)

End Su

Sub RecordSound() 
   'Nahraje zvuk pojmenovan² mysound do pam∞ti v dΘlce 6 sekund 

   Dim Result& 
   Dim errormsg% 
   Dim ReturnString As String * 1024 
   Dim ErrorString As String * 1024 

   CloseSound 

   Result& = mciSendString("open new type waveaudio alias mysound",_
   ReturnString, 1024, 0) 

   If Not Result& = 0 Then 
      errormsg% = mciGetErrorString(Result&, ErrorString, 1024) 
      MsgBox ErrorString, 0, "Chyba" 
      Exit Sub 
   End If 

   Result& = mciSendString("set mysound time format ms bitspersample 8 samplespersec 11025", ReturnString, 1024, 0) 

   If Not Result& = 0 Then 
      errormsg% = mciGetErrorString(Result&, ErrorString, 1024) 
      MsgBox ErrorString, 0, "Chyba" 
      Exit Sub 
   End If 

   'Nahrßvßnφ po dobu 60000 milisekund 
   Result& = mciSendString("record mysound to 60000", ReturnString, 1024, 0) 

   If Not Result& = 0 Then 
      errormsg% = mciGetErrorString(Result&, ErrorString, 1024) 
      MsgBox ErrorString, 0, "Chyba" 
      Exit Sub 
   End If 

End Sub 

Sub PlayRecSound() 
'P°ehraje nahran² zvuk 

   Dim Result& 
   Dim errormsg% 
   Dim ReturnString As String * 1024 
   Dim ErrorString As String * 1024 

   Result& = mciSendString("stop mysound", ReturnString, 1024, 0) 

   If Not Result& = 0 Then 
      errormsg% = mciGetErrorString(Result&, ErrorString, 1024) 
      MsgBox ErrorString, 0, "Chyba" 
      Exit Sub
   End If 

   Result& = mciSendString("play mysound from 1 wait", ReturnString, 1024, 0) 

   If Not Result& = 0 Then 
      errormsg% = mciGetErrorString(Result&, ErrorString, 1024) 
      MsgBox ErrorString, 0, "Chyba" 
   End If 

End Sub

Na formulß° p°idejte dv∞ tlaΦφtka:

Private Sub Command1_Click() 

   RecordSound 

End Sub Private 

Sub Command2_Click() 

   Call PlayRecSound 

End Sub 

Private Sub Form_Unload(Cancel As Integer) 

   CloseSound 

End Sub

Zp∞t