Zum Aufnehmen von Sound in eine WAVE-Datei kann dieses Modul verwendet werden. 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: 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 Dieser Tipp wurde bereits 15.132 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats September 2024 Dieter Otter Übergabeparameter: String oder Array? Mit der IsArray-Funktion lässt sich prüfen, ob es sich bei einem Übergabeparameter an eine Prozedur um ein Array oder einer "einfachen" Variable handelt. sevOutBar 4.0 Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. |
||||||||||||||||
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. |