' Tondatei im WAV-Format generieren
' Aufbau: Stereo, chromatische Tonleiter, je abwechslungsweise links und rechts

Type WavHeader
	ID(0 To 3) As UByte
	anzBytes As ULong
	subID(0 To 3) As UByte
	subSubID(0 To 3) As UByte
	anzHeadBytes As ULong
	codierung As UShort
	aufnahmeVerf As UShort
	abtastfreq As ULong
	bytesPerSec As ULong
	bytesPerSamp As UShort
	bitsPerSamp As UShort 
End Type

Type dataHeader
	ID(0 To 3) As UByte
	AnzBytes As ULong
End Type

Type stereoSamp
	li As Short
	re As Short
End Type

Const SamplPerSec As Integer = 44100
Const AnzSek As Integer = 20
Const pi As Single = 4.0 * Atn(1.0)

Sub SetzeString(a() As UByte, s As String)
   Dim i As Integer	
	For i=0 To Len(s) - 1
		a(LBound(a) + i) = Asc(Mid(s, i + 1, 1))
	Next i
End Sub

Dim wh As WavHeader, dh As dataHeader, sa As stereoSamp
Dim fh As Integer, i As Integer, sampWert As Short

Dim zeit As Single, freq As Single, lire As Integer, naechst As Single

ScreenRes 640, 480, 4
Width 80, 30

SetzeString wh.ID(), "RIFF"
wh.anzBytes = AnzSek * SamplPerSec * 2 * 2 + SizeOf(WavHeader) + SizeOf(dataHeader) - 8
SetzeString wh.subID(), "WAVE"
SetzeString wh.subSubID(), "fmt "
wh.anzHeadBytes = 16
wh.codierung = 1
wh.aufnahmeVerf = 2
wh.abtastfreq = SamplPerSec
wh.bytesPerSec = SamplPerSec * 2 * 2
wh.bytesPerSamp = 2 * 2
wh.bitsPerSamp = 2 * 8

SetzeString dh.ID(), "data"
dh.AnzBytes = AnzSek * SamplPerSec * 2 * 2

' Ab hier unsere Tonleiter generieren

fh = FreeFile
Open "D:\TEMP\Testsound.wav" For Binary As fh
' Header schreiben
Put #fh, , wh
Put #fh, , dh

' Ab hier Töne: Wir spielen C links, dann C# rechts, D wieder links
' D# rechts usw. Länge immer 0.4 sek. (alles einfacher Sinuston)

naechst = 0.5
freq = 220.0 * 2.0 ^ 0.25
lire = 0

For i = 1 To AnzSek * SamplPerSec
	zeit = CSng(i) / CSng(SamplPerSec)
	If zeit > naechst Then
		' Zum nächsten Ton wechseln
		freq *= 2.0 ^ (1.0 / 12.0)
		' Kanal wechseln
		lire = 1 - lire
		naechst += 0.5
	EndIf
	If zeit > naechst - 0.1 Then
		' Tonpause
		sa.li = 0
		sa.re = 0
	Else
		' Ton erzeugen
		sampWert = CInt(16383.0 * Sin((zeit - naechst) * freq * 2.0 * pi))
		If lire = 1 Then
			sa.li = sampWert
			sa.re = 0
		Else
			sa.li = 0
			sa.re = sampWert
		EndIf
	EndIf
	Put #fh, , sa
Next i
Close 1

Print "Wave generiert"
Sleep