Visual Basic 2012 Excel 2013 Multimedia Sound Recorder programmieren von Selzer-McKenzie SelMcKenzie

Visual Basic 2012 Excel 2013 Multimedia Sound Recorder programmieren von Selzer-McKenzie SelMcKenzie

Video: http://youtu.be/XRTfRdGwtzQ

 

 

 

 

Author D.Selzer-McKenzie

Heute zeige ich Ihnen, wie Sie einen Sound-Recorder programmieren. Einen Sound-Recorder, mit dem Sie ohne Zusatzgeräte Musik abspielen können, über Mikrophon aufnehmen können und auch vorlesen lassen können. Ebenfalls kann alles abgespeichert werden.

Natürlich ist das auch mit älteren Visual-Basic-Versionen 2005,2008,2010,2012 möglich und Excel.

Den kompletten Source-Code stelle ich nachstehend ein, Sie sollten sich aber auf dem Film den Source-Code ansehen, dort habe ich ihn abgefilmt.

Hier nun der komplette Source-Code:

Imports System.IO

Imports System.Runtime.InteropServices

Imports System.Text

Imports System.Drawing

Public Class Form1

   

    Private Shared Function mciSendString(lpstrCommand As String,

                                lpstrReturnString As StringBuilder, uReturnLength As Integer,

                                hwndCallback As IntPtr) As Integer

    End Function

   

    Private Shared Function mciGetErrorString(dwError As Integer,

                                  lpstrBuffer As StringBuilder, uLength As Integer) As Integer

    End Function

    Private Function getMciError(errCode As Integer) As String

        Dim errMsg As New StringBuilder(255)

        If mciGetErrorString(errCode, errMsg, errMsg.Capacity) = 0 Then

            Return "MCI-Fehler " & errCode

        Else

            Return errMsg.ToString()

        End If

    End Function

   

    Private Shared Function GetShortPathName(lpszLongPath As String,

                                  lpszShortPath As StringBuilder, cchBuffer As Integer) As Integer

    End Function

    Private Function shortPathName() As String

        Dim shortPath As String = String.Empty

        Dim len As Long = 0

        Dim buffer As New StringBuilder(256)

        Dim s As String = Directory.GetCurrentDirectory()

        len = GetShortPathName(s, buffer, 256)

        shortPath = buffer.ToString()

        Return shortPath

    End Function

    ' ---------------------------------------------------------------------------------------------------

    Private SoundZeichnen As Graphics = Nothing

    Private PufferArray() As Byte = Nothing

    Private BreiteDesDiagramms As Single

    Private KoordinateDiagrammMittellinie As Single

    Private StreckungsfaktorAmplitude As Single

    Private ZählerTicks As Integer

    Private StartzeitAufnahme As DateTime

    Private AbgelaufeneZeit As Integer

    Private TimerInterval As Integer

    Private Const LängeZeitachse As Integer = 60000

    ' ----------------------------------------------------------------------------------------------------

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        SoundZeichnen = SoundPictureBoxDiagramm.CreateGraphics()

        TimerInterval = Uhr10.Interval

        ReDim PufferArray(LängeZeitachse / TimerInterval)       ' 6000 gespeicherte Werte (ca. 1 Minute)  

        BreiteDesDiagramms = SoundPictureBoxDiagramm.Width

        KoordinateDiagrammMittellinie = SoundPictureBoxDiagramm.Height / 2

        StreckungsfaktorAmplitude = KoordinateDiagrammMittellinie / 140

        ' -----------------------------------------------------------------------

        Dim mciString As String = "open new type waveaudio alias myAlias"

        Dim ResRes As Integer = mciSendString(mciString, Nothing, 0, IntPtr.Zero)

        If ResRes <> 0 Then

            MessageBox.Show(getMciError(ResRes),

                            "MCI-Fehler beim Öffnen des Geräts ('Open New'-Befehl)",

                            MessageBoxButtons.OK, MessageBoxIcon.Error)

        End If

        mciString = "set myAlias time format ms bitspersample" &

                       " 8 channels 1 samplespersec 8000 bytespersec 8000"

        ResRes = mciSendString(mciString, Nothing, 0, IntPtr.Zero)

        If ResRes <> 0 Then

            MessageBox.Show(getMciError(ResRes),

                 "MCI-Fehler beim Zuweisen der Parameter ('Set-Befehl)",

                 MessageBoxButtons.OK, MessageBoxIcon.Error)

        End If

        ' ----------------------------------------------------------------------

        mciString = "open new type waveaudio alias myAlias2"

        ResRes = mciSendString(mciString, Nothing, 0, IntPtr.Zero)

        If ResRes <> 0 Then

            MessageBox.Show(getMciError(ResRes),

                            "MCI-Fehler beim Öffnen des Geräts ('Open New'-Befehl)",

                            MessageBoxButtons.OK, MessageBoxIcon.Error)

        End If

        Uhr10.Start()

    End Sub

    Private Sub SoundButtonStartStop_Click(sender As Object, e As EventArgs) Handles SoundButtonStartStop.Click

        If SoundButtonStartStop.Text = "START" Then  ' auf START geklickt

            Dim mciString As String = "record myAlias"

            Dim ResRes As Integer = mciSendString(mciString, Nothing, 0, IntPtr.Zero)

            If ResRes <> 0 Then

                MessageBox.Show(getMciError(ResRes),

                      "MCI-Fehler beim Starten der Aufnahme ('Record-Befehl)",

                      MessageBoxButtons.OK, MessageBoxIcon.Error)

            End If

            SoundButtonStartStop.Text = "STOP"

            ' --------------------------------------------------------------

            StartzeitAufnahme = DateTime.Now

            ZählerTicks = 0

            SoundPictureBoxDiagramm.Refresh()

        Else                        ' auf STOPP geklickt

            saveFile()

            SoundButtonStartStop.Text = "START"

        End If

    End Sub

    Private Sub Uhr10_Tick(sender As Object, e As EventArgs) Handles Uhr10.Tick

        Dim mciString As String = "status myAlias2 level"

        Dim buffer As New StringBuilder(20)

        Dim ResRes As Integer = mciSendString(mciString, buffer, buffer.Capacity, IntPtr.Zero)

        If ResRes <> 0 Then

            MessageBox.Show(getMciError(ResRes),

                       "MCI-Fehler bei der Status-Abfrage  ('status ... level'-Befehl)",

                       MessageBoxButtons.OK, MessageBoxIcon.Error)

        End If

        Dim level As Byte = Byte.Parse(buffer.ToString())    ' 0 ... 127          

        SoundProgressBarPegel.Value = level

        ' ----------------------------------------------------------------

        If SoundButtonStartStop.Text = "STOP" Then

            Dim TheTimeSpan As New TimeSpan(DateTime.Now.Ticks - StartzeitAufnahme.Ticks)

            Dim Sekunden As Integer = Convert.ToInt32(TheTimeSpan.TotalSeconds)

            SoundLabelAnzeigeSekunden.Text = "Laufzeit: " & Sekunden.ToString() & " Sekunden"

            If Sekunden = LängeZeitachse / 1000 Then

                saveFile()

                SoundButtonStartStop.Text = "START"

                Return

            End If

            AbgelaufeneZeit = Convert.ToInt32(TheTimeSpan.TotalMilliseconds)

            Dim x As Single = AbgelaufeneZeit * BreiteDesDiagramms / LängeZeitachse

            SoundZeichnen.DrawLine(New Pen(Color.Yellow, 0.1F), x, KoordinateDiagrammMittellinie - level _

                                        * StreckungsfaktorAmplitude, x, KoordinateDiagrammMittellinie + level * StreckungsfaktorAmplitude)

            PufferArray(ZählerTicks) = level

            ZählerTicks += 1

        End If

    End Sub

    ' -------------------------------------

    '  Sound-Datei im aktuellen Verzeichnis abspeichern:

    Private Sub saveFile()

        Dim mciStr As String = "save myAlias " & shortPathName() & "\Test.wav"

        Dim res As Integer = mciSendString(mciStr, Nothing, 0, IntPtr.Zero)

        If res <> 0 Then

            MessageBox.Show(getMciError(res), "MCI-Fehler beim Speichern der Datei ('Save'-Befehl)", _

                            MessageBoxButtons.OK, MessageBoxIcon.Error)

        End If

    End Sub

 

    Private Sub SoundPictureBoxDiagramm_Paint(sender As Object, e As PaintEventArgs) Handles SoundPictureBoxDiagramm.Paint

        Dim Zeichnen As Graphics = e.Graphics

        Dim dx As Single = BreiteDesDiagramms / LängeZeitachse * AbgelaufeneZeit / ZählerTicks

        For j As Integer = 0 To ZählerTicks - 1

            Zeichnen.DrawLine(New Pen(Color.Yellow, 0.1F), j * dx, KoordinateDiagrammMittellinie _

                              - PufferArray(j) * StreckungsfaktorAmplitude, j * dx, _

                              KoordinateDiagrammMittellinie + PufferArray(j) * StreckungsfaktorAmplitude)

        Next j

    End Sub

End Class