vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

https://www.vbarchiv.net
Rubrik: Multimedia & Sound · Audio   |   VB-Versionen: VB5, VB607.03.05
WAVE-Dateien aufnehmen

Dieser Tipp erklärt, wie sich WAVE-Dateien in unterschiedlichen Qualitätsstufen aufnehmen lassen.

Autor:   Thomas GollmerBewertung:  Views:  14.983 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Zum Aufnehmen von Sound in eine WAVE-Datei kann dieses Modul verwendet werden.
Von welchem Eingang der Soundkarte aufgenommen wird, richtet sich nach den Aufnahmeeinstellungen der Windows.Lautstärkeregelung.

Fügen Sie nachfolgenden Code in ein Modul ein:

Option Explicit
 
' API Deklarationen
Public 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
 
' Aufnahmeformate
Public Enum BitsPerSec
  Bits16 = 16
  Bits8 = 8
End Enum
 
Public Enum SampelsPerSec
  Sampels8000 = 8000
  Sampels11025 = 11025
  Sampels12000 = 12000
  Sampels16000 = 16000
  Sampels22050 = 22050
  Sampels24000 = 24000
  Sampels32000 = 32000
  Sampels44100 = 44100
  Sampels48000 = 48000
End Enum
 
Public Enum Channels
  Mono = 1
  Stereo = 2
End Enum
Public Sub StartRecord(ByVal BPS As BitsPerSec, _
  ByVal SPS As SampelsPerSec, ByVal Mode As Channels)
 
  Dim retStr As String
  Dim cBack As Long
  Dim BytesPerSec As Long
 
  retStr = Space$(128)
  BytesPerSec = (Mode * BPS * SPS) / 8
  mciSendString "open new type waveaudio alias capture", retStr, 128, cBack
  mciSendString "set capture time format milliseconds" & _
    " bitspersample " & CStr(BPS) & _
    " samplespersec " & CStr(SPS) & _
    " channels " & CStr(Mode) & _
    " bytespersec " & CStr(BytesPerSec) & _
    " alignment 4", retStr, 128, cBack
  mciSendString "record capture", retStr, 128, cBack
End Sub
Public Sub SaveRecord(strFile)
  Dim retStr As String
  Dim TempName As String
  Dim cBack As Long
  Dim fs, F
 
  ' Speichern im Root als Temp
  TempName = Left$(strFile, 3) & "Temp.wav"
  retStr = Space$(128)
  mciSendString "stop capture", retStr, 128, cBack
  mciSendString "save capture " & TempName, retStr, 128, cBack
  mciSendString "close capture", retStr, 128, cBack
 
  ' Datei verschieben
  Set fs = CreateObject("scripting.filesystemobject")
  Set F = fs.GetFile(TempName)
  F.Move (strFile)
End Sub

Hier nun ein Beispiel:
Erstellen Sie ein neues Projekt und fügen einen Commandbutton und 3 Optionbuttons ein.

Option Explicit
 
Private Sub Form_Load()
  ' Buttons initialisieren
  Command1.Caption = "Start Aufnahme"
  Option1.Caption = "Telefonqualität"
  Option2.Caption = "Radioqualität"
  Option3.Caption = "CD Qualität"
  Option3.Value = True
End Sub
Private Sub Command1_Click()
  Dim strFileName As String
 
  ' Dateiname
  strFileName = App.Path & "\Aufnahme.wav"
 
  ' Aufnahme starten
  If Command1.Caption = "Start Aufnahme" Then
    ' Aufnahmeformat festlegen
    If Option1.Value = True Then
      StartRecord Bits8, Sampels11025, Mono
    ElseIf Option2.Value = True Then
      StartRecord Bits8, Sampels22050, Mono
    ElseIf Option3.Value = True Then
      StartRecord Bits16, Sampels44100, Stereo
    End If
 
    ' Options sperren & Buttontext ändern
    Option1.Enabled = False
    Option2.Enabled = False
    Option3.Enabled = False
    Command1.Caption = "Stop Aufnahme"
  Else
 
    ' Aufnahme stoppen & Datei speichern/überschreiben
    If Dir(strFileName) <> "" Then Kill strFileName
    SaveRecord strFileName
 
    ' Options freigeben und Buttontext ändern
    Option1.Enabled = True
    Option2.Enabled = True
    Option3.Enabled = True
    Command1.Caption = "Start Aufnahme"
  End If
End Sub



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
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.