Autor: Peter Haserodt  --- Aus Excel VBA - Gruppe: Verschiedenes

Töne erzeugen

Autor: Peter Haserodt - Erstellt: --      - Letzte Revision: --
Beispiele für das Erzeugen von Tönen mit der API Funktion Beep.
Ob diese in allen Windowsversionen so vorhanden ist, weiß ich nicht.
Getestet unter Windows 2000


' **************************************************************
'  Modul:  mdlMusic  Typ = Allgemeines Modul
' **************************************************************

Option Explicit
Option Compare Text
' *******************************************************
' Peter Haserodt 2003
' kleine Spielereien mit Tönen
' Viel Spass beim Ausprobieren und Studieren und Ergänzen
' *******************************************************
' ########### Frequenzen der Töne #### ohne Garantie  ###########
Const c_C = 264
Const c_Cis = 279
Const c_Des = 279
Const c_D = 295
Const c_Dis = 314
Const c_Es = 314
Const c_E = 332
Const c_F = 352
Const c_Fis = 372
Const c_Ges = 372
Const c_G = 392
Const c_Gis = 418
Const c_As = 418
Const c_A = 440
Const c_Ais = 468
Const c_B = 468
Const c_H = 495
' ###########
' API-Deklaration

Private Declare Function Beep Lib "kernel32" _
 (ByVal dwFreq As Long, ByVal dwDuration As Long) _
 As Long
 
Private Sub TestSoundC()
 Beep 264, 1000 ' sollten alle C sein
 Beep 528, 1000
 Beep 792, 1000
End Sub
 
Sub TestSoundA()
 Beep 440, 1000
End Sub
 
Sub PlayRandom()
 Dim iFrequenz As Long, iDAuer As Long
 Dim i As Integer
 Randomize Timer
 For i = 1 To 50
  iFrequenz = Int(1000 * Rnd) + 500
  iDAuer = Int(200 * Rnd) + 100
  Beep iFrequenz, iDAuer
 Next i
End Sub
 
Private Function GibFrequenz(ByVal DerBuchstabe As String) As Long
 Select Case DerBuchstabe
  Case "C": GibFrequenz = c_C
  Case "Cis": GibFrequenz = c_Cis
  Case "Des": GibFrequenz = c_Des
  Case "D": GibFrequenz = c_D
  Case "Dis": GibFrequenz = c_Dis
  Case "Es": GibFrequenz = c_Es
  Case "E": GibFrequenz = c_E
  Case "F": GibFrequenz = c_F
  Case "Fis": GibFrequenz = c_Fis
  Case "Ges": GibFrequenz = c_Ges
  Case "G": GibFrequenz = c_G
  Case "Gis": GibFrequenz = c_Gis
  Case "As": GibFrequenz = c_As
  Case "A": GibFrequenz = c_A
  Case "Ais": GibFrequenz = c_Ais
  Case "B": GibFrequenz = c_B
  Case "H": GibFrequenz = c_H
 End Select
End Function
 
Sub PlayALittleSong()
 Dim fTon(70, 2), i As Integer
 ' ######## Feld Fuellen, würde man natürlich aus ner Textdatei oder so holen
 fTon(0, 0) = "c": fTon(0, 1) = 8: fTon(0, 2) = 1
 fTon(1, 0) = "d": fTon(1, 1) = 8: fTon(1, 2) = 1
 fTon(2, 0) = "e": fTon(2, 1) = 4: fTon(2, 2) = 1
 fTon(3, 0) = "e": fTon(3, 1) = 8: fTon(3, 2) = 1
 fTon(4, 0) = "g": fTon(4, 1) = 8: fTon(4, 2) = 1
 fTon(5, 0) = "f": fTon(5, 1) = 4: fTon(5, 2) = 1
 fTon(6, 0) = "f": fTon(6, 1) = 8: fTon(6, 2) = 1
 fTon(7, 0) = "a": fTon(7, 1) = 8: fTon(7, 2) = 1
 fTon(8, 0) = "g": fTon(8, 1) = 4: fTon(8, 2) = 1
 fTon(9, 0) = "g": fTon(9, 1) = 8: fTon(9, 2) = 1
 fTon(10, 0) = "f": fTon(10, 1) = 8: fTon(10, 2) = 1
 fTon(11, 0) = "e": fTon(11, 1) = 2: fTon(11, 2) = 1
 fTon(12, 0) = "g": fTon(12, 1) = 4: fTon(12, 2) = 1
 fTon(13, 0) = "g": fTon(13, 1) = 8: fTon(13, 2) = 1
 fTon(14, 0) = "f": fTon(14, 1) = 8: fTon(14, 2) = 1
 fTon(15, 0) = "e": fTon(15, 1) = 4: fTon(15, 2) = 1
 fTon(16, 0) = "e": fTon(16, 1) = 8: fTon(16, 2) = 1
 fTon(17, 0) = "g": fTon(17, 1) = 8: fTon(17, 2) = 1
 fTon(18, 0) = "f": fTon(18, 1) = 4: fTon(18, 2) = 1
 fTon(19, 0) = "f": fTon(19, 1) = 4: fTon(19, 2) = 1
 fTon(20, 0) = "d": fTon(20, 1) = 4: fTon(20, 2) = 1
 fTon(21, 0) = "g": fTon(21, 1) = 4: fTon(21, 2) = 1
 fTon(22, 0) = "e": fTon(22, 1) = 2: fTon(22, 2) = 1
 fTon(23, 0) = "c": fTon(23, 1) = 8: fTon(23, 2) = 1
 fTon(24, 0) = "d": fTon(24, 1) = 8: fTon(24, 2) = 1
 fTon(25, 0) = "e": fTon(25, 1) = 4: fTon(25, 2) = 1
 fTon(26, 0) = "e": fTon(26, 1) = 8: fTon(26, 2) = 1
 fTon(27, 0) = "g": fTon(27, 1) = 8: fTon(27, 2) = 1
 fTon(28, 0) = "f": fTon(28, 1) = 4: fTon(28, 2) = 1
 fTon(29, 0) = "f": fTon(29, 1) = 8: fTon(29, 2) = 1
 fTon(30, 0) = "a": fTon(30, 1) = 8: fTon(30, 2) = 1
 fTon(31, 0) = "g": fTon(31, 1) = 4: fTon(31, 2) = 1
 fTon(32, 0) = "g": fTon(32, 1) = 8: fTon(32, 2) = 1
 fTon(33, 0) = "f": fTon(33, 1) = 8: fTon(33, 2) = 1
 fTon(34, 0) = "e": fTon(34, 1) = 2: fTon(34, 2) = 1
 fTon(35, 0) = "g": fTon(35, 1) = 4: fTon(35, 2) = 1
 fTon(36, 0) = "g": fTon(36, 1) = 8: fTon(36, 2) = 1
 fTon(37, 0) = "f": fTon(37, 1) = 8: fTon(37, 2) = 1
 fTon(38, 0) = "e": fTon(38, 1) = 4: fTon(38, 2) = 1
 fTon(39, 0) = "e": fTon(39, 1) = 8: fTon(39, 2) = 1
 fTon(40, 0) = "g": fTon(40, 1) = 8: fTon(40, 2) = 1
 fTon(41, 0) = "f": fTon(41, 1) = 4: fTon(41, 2) = 1
 fTon(42, 0) = "f": fTon(42, 1) = 4: fTon(42, 2) = 1
 fTon(43, 0) = "d": fTon(43, 1) = 4: fTon(43, 2) = 1
 fTon(44, 0) = "g": fTon(44, 1) = 4: fTon(44, 2) = 1
 fTon(45, 0) = "e": fTon(45, 1) = 2: fTon(45, 2) = 1
 fTon(46, 0) = "c": fTon(46, 1) = 4: fTon(46, 2) = 1
 fTon(47, 0) = "e": fTon(47, 1) = 4: fTon(47, 2) = 1
 fTon(48, 0) = "d": fTon(48, 1) = 3: fTon(48, 2) = 1
 fTon(49, 0) = "e": fTon(49, 1) = 8: fTon(49, 2) = 1
 fTon(50, 0) = "f": fTon(50, 1) = 4: fTon(50, 2) = 1
 fTon(51, 0) = "d": fTon(51, 1) = 4: fTon(51, 2) = 1
 fTon(52, 0) = "e": fTon(52, 1) = 3: fTon(52, 2) = 1
 fTon(53, 0) = "f": fTon(53, 1) = 8: fTon(53, 2) = 1
 fTon(54, 0) = "g": fTon(54, 1) = 4: fTon(54, 2) = 1
 fTon(55, 0) = "g": fTon(55, 1) = 8: fTon(55, 2) = 1
 fTon(56, 0) = "g": fTon(56, 1) = 8: fTon(56, 2) = 1
 fTon(57, 0) = "a": fTon(57, 1) = 4: fTon(57, 2) = 1
 fTon(58, 0) = "a": fTon(58, 1) = 5: fTon(58, 2) = 1
 fTon(59, 0) = "c": fTon(59, 1) = 4: fTon(59, 2) = 2
 fTon(60, 0) = "h": fTon(60, 1) = 8: fTon(60, 2) = 1
 fTon(61, 0) = "a": fTon(61, 1) = 8: fTon(61, 2) = 1
 fTon(62, 0) = "g": fTon(62, 1) = 3: fTon(62, 2) = 1
 fTon(63, 0) = "c": fTon(63, 1) = 8: fTon(63, 2) = 1
 fTon(64, 0) = "e": fTon(64, 1) = 8: fTon(64, 2) = 1
 fTon(65, 0) = "g": fTon(65, 1) = 4: fTon(65, 2) = 1
 fTon(66, 0) = "g": fTon(66, 1) = 8: fTon(66, 2) = 1
 fTon(67, 0) = "a": fTon(67, 1) = 8: fTon(67, 2) = 1
 fTon(68, 0) = "g": fTon(68, 1) = 4: fTon(68, 2) = 1
 fTon(69, 0) = "g": fTon(69, 1) = 8: fTon(69, 2) = 1
 fTon(70, 0) = "c": fTon(70, 1) = 8: fTon(70, 2) = 2
 ' Ab hier hatte ich keine Lust mehr ;-)
 ' Und jetzt raus mit der Musi
 For i = 0 To 70
  Beep GibFrequenz(fTon(i, 0)) * fTon(i, 2), (2000 / fTon(i, 1))
 Next i
End Sub
 Peter Haserodt
  • Formelhilfe
  • Makroentwicklung
  • VBA-Programmierung
  • + + + + + + + + +

Weitere Artikel der Gruppe: Verschiedenes Aus Excel VBA
Nach oben