Imports Microsoft.VisualBasic.Devices
Public Class Form1
Dim filepath As String
Dim c As New Computer
Dim computer As New Computer
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
' WAVE Konstanten
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
' WAVE-Datei aufnehmen
Private Declare Auto Function mciSendString Lib "winmm.dll" ( _
ByVal lpstrCommand As String, _
ByVal lpstrRetrunString As String, _
ByVal dwReturnlength As Short, _
ByVal hCallback As Short) As Integer
' Aufnahmeformate
Private Enum BitsPerSec
Bits16 = 16
Bits8 = 8
End Enum
Private Enum SampelsPerSec
Sampels8000 = 8000
Sampels11025 = 11025
Sampels12000 = 12000
Sampels16000 = 16000
Sampels22050 = 22050
Sampels24000 = 24000
Sampels32000 = 32000
Sampels44100 = 44100
Sampels48000 = 48000
End Enum
Private Enum Channels
Mono = 1
Stereo = 2
End Enum
'''
''' Startet die WAVE-Aufnahme
'''
''' Bits pro Sekunde
''' Samples pro Sekunde
''' Stereo oder Mono-Aufnahme
Private Function WAVE_RecordStart(Optional ByVal BitRate As BitsPerSec = BitsPerSec.Bits16, _
Optional ByVal SampleRate As SampelsPerSec = SampelsPerSec.Sampels11025, _
Optional ByVal Mode As Channels = Channels.Stereo) As Boolean
Dim sReturn As String = Strings.Space(256)
Dim cmd As String
cmd = "open new type waveaudio alias recwave"
If mciSendString(cmd, sReturn, 256, 0) <> 0 Then
MsgBox("Fehler beim Anlegen der neuen Aufnahmedatei!", MsgBoxStyle.Exclamation)
Return (False)
End If
' Aufnahmeformat
Dim ByteRate As Integer = (Mode * BitRate * SampleRate) / 8
mciSendString("set recwave time format milliseconds" & _
" bitspersample " & CStr(BitRate) & _
" samplespersec " & CStr(SampleRate) & _
" channels " & CStr(Mode) & _
" bytespersec " & CStr(ByteRate) & _
" alignment 4", sReturn, 256, 0)
cmd = "record recwave"
If mciSendString(cmd, sReturn, 256, 0) <> 0 Then
MsgBox("Fehler bei der Aufnahme!", MsgBoxStyle.Exclamation)
Return (False)
End If
Return (True)
End Function
'''
''' Beendet die WAVE-Aufnahme
'''
''' Datei, unter der die Aufnahme gespeichert werden soll.
Private Function WAVE_RecordStop(ByVal Filename As String) As Boolean
Dim sReturn As String = Strings.Space(256)
Dim cmd As String
Dim Result As Boolean = True
cmd = "stop recwave"
If mciSendString(cmd, sReturn, 256, 0) <> 0 Then
MsgBox("Fehler beim Beenden der Aufnahme!", MsgBoxStyle.Exclamation)
Return (False)
End If
If Filename.Length > 0 Then
' Aufnhame in Datei speichern
cmd = "save recwave " & Filename
If mciSendString(cmd, sReturn, 256, 0) <> 0 Then
MsgBox("Fehler beim Speichern der Aufnahme.", MsgBoxStyle.Exclamation)
Result = False
End If
End If
cmd = "close recwave"
If mciSendString(cmd, sReturn, 256, 0) <> 0 Then
MsgBox("Fehler beim Schließen der Aufnahme...", MsgBoxStyle.Exclamation)
End If
End Function
Private Sub start_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
End Sub
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
End Sub
Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If Nahme.Text = "" Then
MsgBox("Bitte zuerst einen Dateinamen eingeben!", MsgBoxStyle.Exclamation)
Exit Sub
End If
With path
If .ShowDialog = Windows.Forms.DialogResult.OK Then
pfad.Text = .SelectedPath & "\" & Nahme.Text & ".wav"
End If
End With
End Sub
Private Sub pfad_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pfad.TextChanged
End Sub
Private Sub record_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles record.Click
End Sub
Private Sub open_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles open.Click
With file
.Filter = "Wav|*.wav"
If .ShowDialog = Windows.Forms.DialogResult.OK Then
title.Text = .SafeFileName
filepath = .FileName
End If
End With
End Sub
Private Sub playsound_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles playsound.Click
If filepath Is Nothing Then
MsgBox("Bitte zuerst eine Datei auswählen", MsgBoxStyle.Critical)
Exit Sub
End If
My.Computer.Audio.Play(filepath)
End Sub
Private Sub ToolStripButton1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton1.Click
If pfad.Text = "" Then
MsgBox("Bitte zuerst einen pfad auswählen!", MsgBoxStyle.Critical)
Exit Sub
End If
WAVE_RecordStart(Mode:=Channels.Mono)
End Sub
Private Sub ToolStripButton2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripButton2.Click
WAVE_RecordStop(pfad.Text)
End Sub
Private Sub playsrecord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles playsrecord.Click
My.Computer.Audio.Play(pfad.Text, AudioPlayMode.Background)
End Sub
End Class