Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0764: Frequenzgesteuertes Beepen erzeugen unter NT

VB 5/6-Tipp 0764: Frequenzgesteuertes Beepen erzeugen unter NT

 von Henrik Ilgen

Schwierigkeitsgrad:

Verwendete API-Aufrufe: Beep

Download: Download des Beispielprojektes [3.33 KB]

'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 MusicPlay.vbp  ------------
' Die Komponente 'Microsoft Common Dialog Control 6.0 (comdlg32.ocx)' wird benötigt.

'------- Anfang Formular "frmMain" alias frmMain.frm  -------
' Steuerelement: Schaltfläche "cmdSave"
' Steuerelement: Schaltfläche "cmdLoadMelody"
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Textfeld "txtPause" auf Frame1
' Steuerelement: Textfeld "txtDuration" auf Frame1
' Steuerelement: Textfeld "txtSeed" auf Frame1
' Steuerelement: Textfeld "txtMaxFreq" auf Frame1
' Steuerelement: Textfeld "txtMinFreq" auf Frame1
' Steuerelement: Beschriftungsfeld "Label5" auf Frame1
' Steuerelement: Beschriftungsfeld "Label4" auf Frame1
' Steuerelement: Beschriftungsfeld "Label3" auf Frame1
' Steuerelement: Beschriftungsfeld "Label2" auf Frame1
' Steuerelement: Beschriftungsfeld "Label1" auf Frame1
' Steuerelement: Standarddialog-Steuerelement "µ"
' Steuerelement: Timersteuerelement "tmrPlay"
' Steuerelement: Schaltfläche "cmdPlayMelody"
Option Explicit

' Private Variablen
Private IsRunning As Boolean
Private FreqDiff As Long
Private MinFreq As Long
Private Duration As Long
Private Freq As Long

' API-Deklaration (Beep - spielt einen Sound mit bestimmter Frequenz und Dauer)
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

' Lädt eine Melodie aus einer Datei
Private Sub cmdLoadMelody_Click()
   Dim tmpStr As String
   
   With µ
      ' Dialog-Titel setzen
      .DialogTitle = "Melodie öffnen..."
      ' Dateifilter setzen (nur .mdy-Dateien anzeigen)
      .Filter = "Melodie-Dateien (*.mdy))|*.mdy"
      ' Öffnen-Dialog anzeigen
      Call .ShowOpen
      
      ' Wurde eine Datei ausgewählt? Wenn nein, Prozedur verlassen
      If .FileName = "" Then Exit Sub
      
      ' Gewählte Datei öffnen
      Open .FileName For Input As #1
         ' Minimale Frequenz einlesen
         Line Input #1, tmpStr
         txtMinFreq.Text = tmpStr
         
         ' Maximale Frequenz einlesen
         Line Input #1, tmpStr
         txtMaxFreq.Text = tmpStr
         
         ' Seed einlesen
         Line Input #1, tmpStr
         txtSeed.Text = tmpStr
         
         ' Dauer eines Tons einlesen
         Line Input #1, tmpStr
         txtDuration.Text = tmpStr
         
         ' Pause zwischen zwei Tönen einlesen
         Line Input #1, tmpStr
         txtPause.Text = tmpStr
         
      ' Datei wieder schließen
      Close #1
   End With
End Sub

Private Sub cmdPlayMelody_Click()
   ' Wird grade eine Melodie gespielt?
   If Not IsRunning Then
      ' Nein - Neue Melodie initialisieren
      
      ' Wurden gültige Werte eingegeben?
      If Not IsNumeric(txtMinFreq.Text) Or Not IsNumeric(txtMaxFreq.Text) Or Not IsNumeric(txtSeed.Text) Or _
         Not IsNumeric(txtDuration.Text) Or Not IsNumeric(txtDuration.Text) Then
         
         ' Nein - Fehlermeldung ausgeben
         Call MsgBox("Es wurden ungültige Werte eingegeben!", vbExclamation, "Numerische Werte benötigt")
         
         ' Prozedur verlassen
         Exit Sub
      End If
      
      ' Es wird nun eine Melodie gespielt
      IsRunning = True
      
      ' Differenz zwischen höchstem und tiefstem Ton berechnen
      FreqDiff = CLng(txtMaxFreq.Text) - CLng(txtMinFreq.Text)
      ' Minimale Frequenz und Dauer eines Tons einlesen
      MinFreq = CLng(txtMinFreq.Text)
      Duration = CLng(txtDuration.Text)
      
      ' Pause zwischen zwei Tönen einlesen
      tmrPlay.Interval = CLng(txtPause.Text)
      
      ' Wurde ein Seed eingegeben?
      If CLng(txtSeed.Text) <> -1 Then
         ' Ja - Zufallsgenerator zurücksetzen
         Call Rnd(-1)
         ' Zufallsgenerator initialisieren
         Call Randomize(CLng(txtSeed.Text))
      End If
      
      ' Timer aktivieren
      tmrPlay.Enabled = True
      
      ' Beschriftung ändern
      cmdPlayMelody.Caption = "Melodie anhalten"
   Else
      ' Ja - Melodie anhalten
      ' Es wird keine Melodie mehr abgespielt
      IsRunning = False
      ' Timer deaktivieren
      tmrPlay.Enabled = False
      
      ' Beschriftung des Fensters ändern
      Me.Caption = "Musikplayer"
      ' Beschriftung ändern
      cmdPlayMelody.Caption = "Melodie spielen"
   End If
End Sub

Private Sub cmdSave_Click()
   With µ
      ' Dialog-Titel setzen
      .DialogTitle = "Melodie speichern unter..."
      ' Datei-Filter setzen (siehe cmdLoadMelody_Click() )
      .Filter = "Melodie-Dateien (*.mdy))|*.mdy"
      ' Speichern-Dialog anzeigen
      Call .ShowSave
      
      ' Wurde eine Datei ausgewählt? Wenn nein, Prozedur beenden
      If .FileName = "" Then Exit Sub
      
      ' Gewählte Datei öffnen
      Open .FileName For Output As #1
         ' Minimale Frequenz speichern
         Print #1, txtMinFreq.Text
         ' Maximale Frequenz speichern
         Print #1, txtMaxFreq.Text
         ' Seed speichern
         Print #1, txtSeed.Text
         ' Dauer eines Tons speichern
         Print #1, txtDuration.Text
         ' Pause zwischen zwei Tönen speichern
         Print #1, txtPause.Text
         
      ' Datei wieder schließen
      Close #1
      
      ' Meldung ausgeben, dass die Datei gespeichert wurde
      Call MsgBox("Datei wurde unter " & .FileName & " gespeichert.", vbInformation, "Datei gespeichert")
   End With
End Sub

Private Sub tmrPlay_Timer()
   ' Frequenz berechnen - die Frequenz ist größer/gleich MinFreq und kleiner/gleich MinFreq + FreqDiff
   Freq = Rnd() * FreqDiff + MinFreq
   ' Ton abspielen
   Call Beep(Freq, Duration)
   
   ' Beschriftung des Fensters setzen
   Me.Caption = "Musikplayer - " & CStr(Freq) & "Hz"
End Sub
'-------- Ende Formular "frmMain" alias frmMain.frm  --------
'------------- Ende Projektdatei MusicPlay.vbp  -------------