VB 5/6-Tipp 0512: Schnelle Erzeugung und Ausgabe von Wavs via Soundkarte
von Klaus Langbein
Beschreibung
Wenn man nur einfache Töne benötigt, reicht es aus eine sehr kurze Wavdatei im RAM zu erzeugen um diese dann mittels Loop-Flag belieg oft zu widerholen.
Das Beispiel demonstriert auch die Erzeugung der Frequenzen der Tonleiter und abspielen einer kleinen Melodie.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: PlaySoundA (PlaySound), PlaySoundA (PlaySoundData), sndPlaySoundA (sndPlaySound) | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Project1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Schaltfläche "Command1" ' Steuerelement: Textfeld "txtMelody" ' Steuerelement: Schaltfläche "cmdStop" ' Steuerelement: Timersteuerelement "Timer1" ' Steuerelement: Textfeld "txtF2" ' Steuerelement: Textfeld "txtF1" ' Steuerelement: Schaltfläche "cmdPlay" ' Steuerelement: Beschriftungsfeld "Label1" (Index von 0 bis 1) ' ' --------------------------------------------------------- ' ' Wenn man weiß, wie der Header einer Wav-Datei aussieht ' (siehe Tipp zum Auslesen des Headers einer Wav-Datei), ' ist es recht einfach, eine Wav-Datei selbst zu schreiben. ' Im einfachsten Fall (8-Bit Mono) wird jedes Byte, was auf den ' Header folgt, als Amplitudenwert angesehen. Bei 16-Bit Stereodatein ' werden je 16 Bit (d.h. je ein Integer) abwechselnd fuer ' den rechten- u. linken Kanal geschrieben. In vorliegenden ' Beispiel beschränken wir uns auf dieses Format. ' ' Der einfachste Ton, ein Sinus, kann natürlich auch ohne ' Probleme über die Sin()-Funktion erzeugt werden. Die Tonhöhe ' ergibt sich aus der Abspielrate und der Schrittweite, mit welcher ' der Sinus berechnet wird. Ein einfacher Sinus klingt allerdings ' etwas dumpf. Wenns besser klingen soll, muss man schon etwas ' tiefer in die Trickkiste greifen.... ' ' Um Töne quasi ohne Zeitverzögerung zu erzeugen beschränken wir uns ' hier auf die Generierung nur einer Periode. Der Ton wird dann ' mit dem Loop-Flag abgespielt (d.h er widerholt sich ständig), bis ' er angehalten wird. Hier muß man darauf achten, dass die Amplitudenwerte ' beider Kanäle am Anfang und Ende nahtlos aneinander passen. ' ' Autor: K. Langbein (E-Mail: Klaus@ActiveVB) Option Explicit Private Declare Function sndPlaySound Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _ ByVal uFlags As Long) As Long Private Declare Function PlaySoundData Lib "winmm.dll" _ Alias "PlaySoundA" (lpData As Any, _ ByVal hModule As Long, _ ByVal dwFlags As Long) As Long Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _ (ByVal lpszName As String, ByVal hModule As Long, _ ByVal dwFlags As Long) As Long Const pi = 3.14159265358979 Private Type wave_data_16bit R As Integer l As Integer End Type Private Type Standard_Wave_Header Riff As Long ' Sollte immer "RIFF" enthalten = 1179011410 Rl As Long ' Groesse des folgenden "Chunks" Typ As Long ' Typinformation 4 byte "WAVE" = 1163280727 Fmt As Long ' Muss "fmt " enthalten = 544501094 CSize As Long ' Chunksize Tag As Integer ' Meist unbenutzt nChan As Integer ' Zahl der Kanäle sps As Long ' Samples pro Sekunde Bps As Long ' Bytes pro Sekunde Bla As Integer ' Blockalign (Byte pro Sample) Sl As Integer ' Samplelänge Data As Long ' Muss "DATA" enthalten = 1096040772 Dl As Long ' Datenlänge Snd(1 To 5000) As wave_data_16bit ' Hier wird einfach ein genügend ' großes Feld vordimensioniert, was auch bei 10 Hz noch einen ' vollständigen Sinus aufnehmen kann. Dieses Feld muß nicht ' unbedingt vollgeschrieben werden, da man die Spieldauer ja über Dl ' festlegt. End Type Private Type Sound_Descriptor Name As String ' C, D, E, F usw. Freq1 As Single ' Freqenz links Freq2 As Single ' Duration As Long ' Dauer in ms End Type Private mySound As Standard_Wave_Header Dim Ton() As Sound_Descriptor Dim stopp As Long Function bite$(tests$, delim$) ' Funktion zum abbeißen ;-) Dim pos As Integer Dim bit$ pos = InStr(1, tests$, delim$, 1) If pos > 0 Then bit$ = Left$(tests$, pos - 1) tests$ = Right$(tests$, Len(tests$) - Len(bit$) - Len(delim$)) Else bit$ = tests$ End If bite$ = bit$ End Function Public Function FrequencyOf(ByVal ix As Long, Optional ByVal Oktav = 1) As Double 'Notiz zur Frequenzberechnung: 'Folgende Berechnung gilt fuer die sog. physikalische Stimmung der 'chromatischen Tonleiter. Als Referenz wird der Ton A=440 HZ (Oktav=1) 'und seine Subharmonischen verwendet. ' 'Die Frequenz (F2) eines Tons errechnet sich aus der Frequenz (F1) des ' vorangegangenen mal der 12. Wurzel aus 2, d.h. F2 = F1*2^(1/12) ' 'Vorgehensweise: 'Zur Ermittlung des C wird erst die Subharmonische von A 'berechnet. Dh 1 Oktave unter der angegebenen Oktave. 'Basierend auf diesem A wird zunaechst hochgerechnet bis zum 'darauf folgenden C, d.h. 3 Toene weiter. ' f= basef (zb basef=220) ' ' For i = 10 To 12 ' f = f * 2 ^ (1 / 12) ' Next i ' 'Von hier aus kann jetzt bist zum angegebenen Index weiter 'gerechnet werden: ' ' For i = 2 To ix ' f = f * 2 ^ (1 / 12) ' Next i ' 'Beide Teilschleifen koennen auch zusammengefasst werden. Dh 'zur 2. Schleife werden 3 Schritte dazugerechnet. ' ' For i = 1 To ix + 2 ' f = f * 2 ^ (1 / 12) ' Next i ' ' Diese Schleife kann zusammengefasst werden zu ' f = f * (2^(1/12)) ^ (ix + 2) ' 'Beispiel: Ton 3, Oktav 1 'Als Grundfrequenz fuer Oktav 0 wird A=220 ermittelt. 'Fuer das darauf folgende C errechnet sich C=261.625565300599 'Von da wird bis zum 3. Ton = D = 293Hz weiter gerechnet. Dim f As Double Dim basef As Double Dim ff As Double basef = 13.75 If Oktav <= -3 Then Oktav = -3 End If Oktav = Oktav + 3 basef = basef * 2 ^ Oktav ff = 2 ^ (1 / 12) f = basef * ff ^ (ix + 2) FrequencyOf = f End Function Function GetIndex(ByVal Name As String) As Long Dim i As Long For i = 1 To UBound(Ton) If Ton(i).Name = Name Then GetIndex = i Exit Function End If Next i End Function Private Sub MakeSound(Sound As Standard_Wave_Header, _ ByVal Freq1 As Double, _ ByVal Freq2 As Double) Dim nSamples As Long ' Zahl der Samples Dim tStep As Double ' Schrittweite der Zeit in Sek. Dim t As Double ' Zeit Dim sps As Long ' Samples pro Sekunde Dim w1 As Double ' Kreisfrequenz Omega Dim w2 As Double ' Dim A As Double ' Max. Amplitude (32000 für Integers) Dim aStep As Double ' Schrittweite für Reduzierungder Aplitude Dim n As Long ' Exponent (erzeugt Saitenähnlichen Klang Dim tau As Double sps = 44100 tStep = 1 / sps ' Schrittweite für die Zeit tau = 1 / Freq1 nSamples = tau / tStep w1 = 2 * pi * Freq1 ' Berechnung der Kreisfrequenz w2 = 2 * pi * Freq2 ' Leichte Unterschiede zw. den Frequenz der ' beiden Kanäle erzeugen eine Schwebung. A = 32000 ' Maximale Amplitude. Wenns leiser sein soll, ' kleinere Werte einsetzen n = 101 ' Für einen reinen Sinus wird n=1 gesetzt ' Hohe ungerade Werte erzeugen einen saitenählichen ' Klang. Gerade Werte verdoppeln die Frequenz und ' man erhält zB für n=2 einen klavierähnlichen Ton' aStep = A / nSamples ' Für konstanten Ton, aStep = 0 setzen If nSamples > UBound(Sound.Snd) Then nSamples = UBound(Sound.Snd) End If Call PrepareHeader(Sound, nSamples, 2, sps, 16) Dim i For i = 1 To nSamples mySound.Snd(i).l = A * Sin(w1 * t) ^ n ' Amplitudenwert berechnen mySound.Snd(i).R = A * Cos(w2 * t) ^ n ' Cos erzeugt 180° Phasenverschiebung ' zwischen den beiden Kanälen. t = t + tStep ' Zeit hochzählen Next i ' Das Umspeichern entfällt hier, da wir unseren einenen Typen ' an die PlaySoundData-API übergeben können. End Sub Sub Melody(ByVal Melo$) Dim t$, i, ret ' VB6-Benutzer können hier Replace verwenden Melo = ReplaceVB5(Melo, vbCrLf, " ") Do t$ = bite(Melo$, " ") If t$ = " " Then Goto skip End If i = GetIndex(t$) If i > 0 Then Call MakeSound(mySound, Ton(i).Freq1, Ton(i).Freq1) ret = PlayWavData(mySound, 8 Or 1) Else ' dann isses ne Pause End If Timer1.Interval = Ton(i).Duration Timer1.Enabled = -1 Do DoEvents Loop Until Timer1.Enabled = 0 skip: Loop Until Melo$ = t$ Or stopp = 1 End Sub Private Function PlayWavData(ByRef WaveData As Standard_Wave_Header, _ ByVal flag As Long) As Long ' spielt ein WAV aus Byte-Array im RAM On Error Resume Next Dim ret As Long Const SND_MEMORY = &H4 ret = PlaySoundData(WaveData, 0, SND_MEMORY Or flag) End Function Private Function PrepareHeader(ByRef Header As Standard_Wave_Header, _ ByVal nSamples As Long, _ ByVal nChannels As Long, _ ByVal SamplesPerSecond As Long, _ ByVal BitsPerSample) Dim DataLength As Long Dim Rl As Long ' Länge der 'Riff'-Chunks DataLength = nSamples * nChannels * BitsPerSample / 8 Rl = 16 + 4 + 4 ' Länge des Formatchunks + 4 Byte für "fmt " + 4 Rl = Rl + DataLength ' plus Datenlänge Rl = Rl + 4 + 4 + 4 ' Header.Riff = 1179011410 ' Wir übereben ein Long welches der ' die gleiche Bytefolge wie "RIFF" hat Header.Rl = Rl Header.Typ = 1163280727 ' = "WAVE" Header.Fmt = 544501094 ' = "fmt " Header.CSize = 16 ' Länge des folgenden Chunks Header.Tag = 1 Header.nChan = nChannels Header.sps = SamplesPerSecond Header.Bla = nChannels * BitsPerSample / 8 Header.Bps = Header.sps * Header.Bla Header.Sl = BitsPerSample Header.Data = 1635017060 Header.Dl = DataLength End Function Private Sub cmdPlay_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) Dim ret Call MakeSound(mySound, Val(txtF1.Text), Val(txtF2.Text)) ret = PlayWavData(mySound, 8 Or 1) End Sub Private Sub cmdPlay_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) If X < 0 Or Y < 0 Then Call cmdStop_Click End If If X > cmdPlay.Width Or Y > cmdPlay.Height Then Call cmdStop_Click End If End Sub Private Sub cmdPlay_MouseUp(Button As Integer, Shift As Integer, _ X As Single, Y As Single) Call cmdStop_Click End Sub Private Sub cmdStop_Click() Call PlaySound(vbNullString, 0, 1) stopp = 1 End Sub Private Sub Command1_Click() stopp = 0 Call Melody(txtMelody.Text) End Sub Private Sub Form_Load() Dim i As Long ReDim Ton(0 To 12) Ton(1).Name = "C" Ton(2).Name = "Cis" Ton(3).Name = "D" Ton(4).Name = "Dis" Ton(5).Name = "E" Ton(6).Name = "F" Ton(7).Name = "Fis" Ton(8).Name = "G" Ton(9).Name = "Gis" Ton(10).Name = "A" Ton(11).Name = "B" Ton(12).Name = "C" For i = 1 To 12 Ton(i).Duration = 300 Ton(i).Freq1 = FrequencyOf(i) Ton(i).Freq2 = Ton(i).Freq1 Next i Ton(0).Duration = 100 ' Dummyton als Pause End Sub Private Sub Timer1_Timer() Call PlaySound(vbNullString, 0, 1) Timer1.Enabled = 0 End Sub Function ReplaceVB5$(ByVal test$, str1$, str2$) Dim pos As Long Dim nestr$ Dim newstr$ pos = 1 newstr$ = "" Do pos = InStr(1, test$, str1$, 0) If pos > 0 Then newstr$ = newstr$ + Left$(test$, pos - 1) + str2$ test$ = Right$(test$, Len(test$) - pos - Len(str1$) + 1) Else newstr$ = newstr$ + test$ End If Loop Until pos = 0 ReplaceVB5$ = newstr$ End Function '---------- Ende Formular "Form1" alias Form1.frm ---------- '-------------- Ende Projektdatei Project1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
VB5 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
VB6 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Rene Jungmann am 23.12.2006 um 01:30
Hallo,
das ist genau das, was ich gesucht habe. Leider funktioniert es bei mir unter vb.net nicht. Ok, ich weiß, dass es für eine ältere VB-Version geschrieben wurde, aber das Programm lässt sich problemlos ausführen, nur ist leider nichts zu hören.
Grüße
René
Kommentar von Hermann Sereinig am 20.10.2005 um 08:55
Ich wäre ihnen sehr dankbar, wenn sie mir Informationen geben könnten, die es mir ermöglichen (einfache) Töne und sogenannte Doppeltöne (wie die Töne einer Telefontastatur) mit variabler Frequenz und Dauer mit der Sondkarte des PC's mittels VB zu erzeugen.
Ich hoffe Sie helfen mir - vielen Dank
Hermann Sereinig
Kommentar von Matthias Elser am 11.07.2003 um 12:31
Hi!
Leider bekomme ich bei der Überprüfung der ausgegebenen Sin-Waves mittels eines Frequenzmessgerätes seltsame Werte!
Wie genau wird die Frequenz hier ausgegeben?
Durch die durchgehende Verwendung von Doubles müßte doch auch die Eingabe von Kommawerten (z.B. 440,21) im Beispielproj. möglich sein? Oder nimmt die Val-Funktion eine Typauswertung vor?
Ich bräuchte die Ausgabe sehr genauer Frequenzen zu Untersuchungszwecken an historischen Stimmungen von Tasteninstrumenten.
Würde mich sehr über weitere Hilfe freuen!
Gruß,
Matthias E.