Aufzeichnen von .WAV-Dateien Mit der nachfolgenden Routine ist es möglich eine WAVE-Datei über das Mikrofon aufzunehmen. Die Aufnahme erreicht hierbei eine Qualität von 8 Bit be...
Autor:   Heinz Prelle	Bewertung:	Views:  25.697
www.visual-basic5.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Mit der nachfolgenden Routine ist es möglich eine WAVE-Datei über das Mikrofon aufzunehmen. Die Aufnahme erreicht hierbei eine Qualität von 8 Bit bei 11025 Hz.

' Zunächst die benötigten API-Deklarationen
 
Private Declare Function mciSendStringA Lib "winmm.dll" ( _
  ByVal lpstrCommand As String, _
  ByVal lpstrRetrunString As String, _
  ByVal dwReturnlength As Integer, _
  ByVal hCallback As Integer) As Long
 
Private Declare Function sndPlaySound Lib "winmm.dll" _
  Alias "sndPlaySoundA" ( _
  ByVal lpszSoundName As String, _
  ByVal uFlags As Long) As Long
 
' WAVE Konstanten
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
 
' WAVE-Datei aufnehmen
Private Sub WAVE_RecordStart()
  Dim antwort
  Dim strAufnahme As String * 256
  Dim cmd As String
 
  cmd = "open new type waveaudio alias recwave"
  antwort = mciSendStringA(cmd, strAufnahme, 256, 0)
  If antwort <> 0 Then
    MsgBox "Fehler beim Anlegen der neuen Datei!"
    Exit Sub
  End If
 
  cmd = "record recwave"
  antwort = mciSendStringA(cmd, strAufnahme, 256, 0)
  If antwort <> 0 Then
    MsgBox "Fehler bei der Aufnahme!"
  End If
End Sub
 
' Aufnahme stoppen/beenden
Private Sub WAVE_RecordStop()
  Dim antwort
  Dim strAufnahme As String * 256
 
  cmd = "stop recwave"
  antwort = mciSendStringA(cmd, strAufnahme, 256, 0)
  If antwort <> 0 Then
    MsgBox "Fehler beim Beenden der Aufnahme..."
    Exit Sub
  End If
 
  cmd = "save recwave " + Trim$(Text2.Text)
  antwort = mciSendStringA(cmd, strAufnahme, 256, 0)
  If antwort <> 0 Then
    MsgBox "Fehler beim Speichern der Aufnahme..."
    Exit Sub
  End If
 
  cmd = "close recwave"
  antwort = mciSendStringA(cmd, strAufnahme, 256, 0)
  If antwort <> 0 Then
    MsgBox "Fehler beim Schließen der Aufnahme..."
    Exit Sub
  End If
End Sub

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.