VB-Homepage Tipp 125
eigene Klänge für den PC-Speaker erzeugen
Nach ersten Anfängen mit Turbo Pascal 6.01, das sehr schnell ein jähes Ende nahm, da ich einfach nicht klar gekommen bin, war mir einfach zu aufwendig, mich da autodidaktisch durch zu wursteln, hatte ich eine Programmiersprache entdeckt, die zwar gemessen an TP oder VB einen sehr kleinen Funktionsumfang hatte, aber das notwendigste enthielt und leicht überschaubar war.
Es handelt sich um Harper Programmer falls dies einer kennt.

Eine Möglichkeit war das erzeugen von Klängen in der Syntax
Beep Frequenz/Dauer/Anzahl (des Tons)

Eine feine Sache, denn so konnte man mit wenig Mühe sich eigene Klangsequenzen erzeugen und über den PC-Speaker ausgeben, denn den hat ja nun wirklich jeder.

Als ich später mit VB anfing, habe ich (wie einiges anderen auch) diese Funktionalität vermißt, denn dieser klägliche Systembeeps ist ja wirklich kein Ersatz. Nun aber ist mir etwas in die Hände gefallen, das genau diese Funktion übernimmt, auch hier ist es möglich, das Sie eigene Klangsequenzen erzeugen und über den PC-Speaker ausgeben können. Eine feine Sache finde ich.

sndspeak.mak
SNDSPEAK.FRM
ProjWinSize=152,402,248,215
ProjWinShow=2
IconForm="Form1"
Title="Mehr als ein Systembeep"
ExeName="SNDSPEAK.EXE"

snspeak.frm
VERSION 2.00
Begin Form Form1
BorderStyle = 3 'Fixed Double
Caption = "VB-Homepage Tipp"
ClientHeight = 2805
ClientLeft = 1095
ClientTop = 1485
ClientWidth = 6270
Height = 3210
Left = 1035
LinkTopic = "Form1"
ScaleHeight = 2805
ScaleWidth = 6270
Top = 1140
Width = 6390
Begin CommandButton Command5
Caption = "Eigenes zum Testen"
Height = 375
Left = 360
TabIndex = 5
Top = 1320
Width = 5535
End
Begin CommandButton Command4
Caption = "Sirene"
Height = 495
Left = 4680
TabIndex = 3
Top = 720
Width = 1215
End
Begin CommandButton Command3
Caption = "Fehler"
Height = 495
Left = 3240
TabIndex = 2
Top = 720
Width = 1215
End
Begin CommandButton Command2
Caption = "Klick"
Height = 495
Left = 1800
TabIndex = 1
Top = 720
Width = 1215
End
Begin CommandButton Command1
Caption = "Anruf"
Height = 495
Left = 360
TabIndex = 0
Top = 720
Width = 1215
End
Begin Label Label4
Alignment = 2 'Center
Caption = "Ausgabe über PC-Speaker"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 360
TabIndex = 8
Top = 2040
Width = 5535
End
Begin Label Label3
Alignment = 2 'Center
Caption = "Tipp von : Gordon F. MacLeod / Gefunden auf : Visual Basic Explorer"
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 360
TabIndex = 7
Top = 2520
Width = 5535
End
Begin Label Label2
Alignment = 2 'Center
Caption = "Klänge erzeugen ohne zusätzliche DLL oder VBX"
Height = 255
Left = 360
TabIndex = 6
Top = 1800
Width = 5535
End
Begin Label Label1
Alignment = 2 'Center
Caption = "SOUND.DRV - mehr als ein Systembeep"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Arial"
FontSize = 12
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 375
Left = 120
TabIndex = 4
Top = 120
Width = 6015
End
End
Declare Function OpenSound% Lib "sound.drv" ()
Declare Function VoiceQueueSize% Lib "sound.drv" (ByVal nVoice%, ByVal nByteS)
Declare Function SetVoiceSound% Lib "sound.drv" (ByVal nSource%, ByVal Freq&, ByVal nDuration%)
Declare Function StartSound% Lib "sound.drv" ()
Declare Function CloseSound% Lib "sound.drv" ()
Declare Function WaitSoundState% Lib "sound.drv" (ByVal State%)
Sub AttenSound1 ()
Dim Succ, S As Integer
Succ = OpenSound()
S = SetVoiceSound(1, 1500 * 2 ^ 16, 50)
S = SetVoiceSound(1, 1000 * 2 ^ 16, 50)
S = SetVoiceSound(1, 1500 * 2 ^ 16, 100)
S = SetVoiceSound(1, 1000 * 2 ^ 16, 100)
S = SetVoiceSound(1, 800 * 2 ^ 16, 40)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
Sub ClickSound1 ()
Dim Succ, S As Integer
Succ = OpenSound()
S = SetVoiceSound(1, 2200 * 2 ^ 16, 10)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
Sub Command1_Click ()
Call AttenSound1
End Sub
Sub Command2_Click ()
Call ClickSound1
End Sub
Sub Command3_Click ()
Call ErrorSound1
End Sub
Sub Command4_Click ()
Call SirenSound1
End Sub
Sub Command5_Click ()
Dim Succ, S As Integer
Succ = OpenSound()
' Tonfrequenz,Länge
S = SetVoiceSound(1, 900 * 2 ^ 16, 50)
S = SetVoiceSound(1, 800 * 2 ^ 16, 50)
S = SetVoiceSound(1, 900 * 2 ^ 16, 10)
S = SetVoiceSound(1, 900 * 2 ^ 16, 10)
S = SetVoiceSound(1, 900 * 2 ^ 16, 10)
S = SetVoiceSound(1, 800 * 2 ^ 16, 50)
S = SetVoiceSound(1, 900 * 2 ^ 16, 50)
S = SetVoiceSound(1, 1000 * 2 ^ 16, 50)
S = SetVoiceSound(1, 1000 * 2 ^ 16, 50)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
Sub ErrorSound1 ()
Dim Succ, S As Integer
Succ = OpenSound()
S = SetVoiceSound(1, 200 * 2 ^ 16, 150)
S = SetVoiceSound(1, 100 * 2 ^ 16, 100)
S = SetVoiceSound(1, 80 * 2 ^ 16, 90)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
Succ = CloseSound()
End Sub
Sub SirenSound1 ()
Dim Succ As Integer
Dim J As Long
Succ = OpenSound()
For J = 440 To 1000 Step 5
Call Sound(J, J / 100)
Next J
For J = 1000 To 440 Step -5
Call Sound(J, J / 100)
Next J
Succ = CloseSound()
End Sub
Sub Sound (ByVal Freq As Long, ByVal Duration As Integer)
Dim S As Integer
' Shift frequency to high byte.
Freq = Freq * 2 ^ 16
S = SetVoiceSound(1, Freq, Duration)
S = StartSound()
While (WaitSoundState(1) <> 0): Wend
End Sub

Wenn Sie diesen Tipp nutzen möchten, erstellen Sie mit einem Editor
Dateien die Sie wie angegeben benennen und fügen den Code ein.
Tipp-Download
Quelle : Gordon F. MacLeod
Zurück zur Übersichtsseite