Date: 02-16-2022
Return to Index
created by gbSnippets
'Credit: Semen Matusovski
'Compilable Example: (Jose Includes)
#Compile Exe
#Register None
#Dim All
$Include "win32Api.Inc"
Sub Sound (Frequence As Long, Duration As Single)
Static IdOS%
If IdOS% = 0 Then
Dim os As OSVERSIONINFO
os.dwOSVersionInfoSize = SizeOf(os)
GetVersionEx ByVal VarPtr(os)
If (os.dwPlatformId = %VER_PLATFORM_WIN32_NT) <> 0 Then _
IdOS% = 1 Else IdOS% = 2
End If
Local Cnt??, x1?, x2?, DurationMSec As Long
If Frequence < 32 Or Frequence > 32767 Then Exit Sub
If Duration < 0.1 Or Duration > 65535 Then Exit Sub
DurationMSec = 1000 / 18.2 * Duration
If IdOS% = 1 Then
WinBeep Frequence, DurationMSec
Else
Cnt?? = 1193180 / Frequence
x1? = LoByt(Cnt??)
x2? = HiByt(Cnt??)
! MOV AL, &HB6
! OUT &H43, AL
! MOV AL, x1?
! OUT &H42, AL
! MOV AL, x2?
! OUT &H42, AL
! In AL, &H61
! OR AL, 3
! OUT &H61, AL
Sleep DurationMSec
! In AL, &H61
! AND AL, &HFD
! OUT &H61, AL
End If
End Sub
' Loop two sounds down at decreasing time intervals
Sub Bounce (Hi As Long, Low As Long)
Local Count As Long
For Count = 60 To 1 Step -2
Sound Low - Count / 2, Count / 20
Sound Hi, Count / 15
Next
End Sub
' Loop down from a high sound to a low sound
Sub Fall (Hi As Long, Low As Long, Del As Long)
Local Count As Long
For Count = Hi To Low Step -10
Sound Count, Del / Count
Next
End Sub
' Alternate two sounds until a key is pressed
Sub Klaxon (Hi As Long, Low As Long, Nmb As Long)
Local Count As Long
For Count = 1 To Nmb
Sound Hi, 5: Sound Low, 5
Next
End Sub
' Loop a sound from low to high to low
Sub Siren (Hi As Long, Range As Long, Nmb As Long)
Local Count1 As Long, Count2 As Long
For Count1 = 1 To Nmb
Count2 = Range
Do
If Count2 < -Range Then Exit Do
Sound Hi - Abs(Count2), .3
Count2 = Count2 - 2 / Range
Count2 = Count2 - 4
Loop
Next
End Sub
' Song
Sub MaryLamb
Sound 330, 5: Sound 294, 5: Sound 262, 5: Sound 294, 5
Sound 330, 5: Sound 330, 5: Sound 330, 10
Sound 294, 5: Sound 294, 5: Sound 294, 10: Sound 330, 5
Sound 392, 5: Sound 392, 10: Sound 330, 5
Sound 294, 5: Sound 262, 5: Sound 294, 5: Sound 330, 5
Sound 330, 5: Sound 330, 5: Sound 330, 5
Sound 294, 5: Sound 294, 5: Sound 330, 5
Sound 294, 5: Sound 262, 5
End Sub
Sub xPlay (Music$)
Static Takts As Long, dOct As Long, dLong As Long, dRt As Long
Local w$, i As Long, j As Long, Dt As Long, Nmb As Long, Nt As Long, Oct As Long
Local Frequence As Single, Duration As Single
Local LMusic As Long, Op$, i1 As Long, i2 As Long, k As Long
If Takts = 0 Then dOct = 4: Takts = 120: dLong = 1
Music$ = UCase$(Music$): LMusic = Len(Music$): i1 = 1
Do
If i1 > LMusic Then Exit Do
i2 = i1 + 1
Do
If i2 > LMusic Then Exit Do
j = InStr("CDEFGABOLPTMN<> ", Mid$(Music$, i2, 1)): If j > 0 Then Exit Do
Incr i2
Loop
Op$ = Mid$(Music$, i1, i2 - i1)
Nmb = 0: Dt = 0
For k = Len(Op$) To 1 Step -1
j = Asc(Op$, k)
Select Case j
Case 46: If Nmb > 0 Then Exit For Else Incr Dt
Case 48 To 57: Incr Nmb
Case Else
If Nmb > 0 Then Nmb = Val(Mid$(Op$, k + 1, Nmb)): If Nmb = 0 Then Exit For
Select Case Left$(Op$, k)
Case "C": Nt = 1
Case "C+", "C#", "D-": Nt = 2
Case "D": Nt = 3
Case "D+", "D#", "E-": Nt = 4
Case "E": Nt = 5
Case "F": Nt = 6
Case "F+", "F#", "G-": Nt = 7
Case "G": Nt = 8
Case "G+", "G#", "A-": Nt = 9
Case "A": Nt = 10
Case "A+", "A#", "B-": Nt = 11
Case "B": Nt = 12
Case "P": Nt = 13
Case "N": If Nmb > 84 Then Exit For Else Nt = 14
Case "T"
If Nmb >= 32 And Nmb <= 255 Then Takts = Nmb
Exit For
Case "L"
If Nmb >= 1 And Nmb <= 64 Then dLong = Nmb
Exit For
Case "O"
If Nmb <= 6 Then dOct = Nmb
Exit For
Case "<"
If Nmb = 0 Then Nmb = 1
dOct = dOct - Nmb
If dOct < 0 Then dOct = 0
Exit For
Case ">"
If Nmb = 0 Then Nmb = 1
dOct = dOct + Nmb
If dOct > 6 Then dOct = 6
Exit For
Case "MN": dRt = 0: Exit For
Case "MS": dRt = 1: Exit For
Case "ML": dRt = 2: Exit For
Case Else: Exit For
End Select
If Nt >= 1 And Nt <= 14 Then
If Nt = 14 Then
If Nmb = 0 Then Nt = 13 Else Oct = Fix((Nmb - 1) / 12): Nt = Nmb - 12 * Oct
Nmb = 0
Else
If Nmb < 0 Or Nmb > 64 Then Exit Do
Oct = dOct
End If
If Nmb = 0 Then Nmb = dLong
Duration = 1092 / Takts / Nmb * 4
Select Case Dt
Case 1: Duration = Duration * 1.5
Case 2: Duration = Duration * 1.75
Case >= 3: Duration = Duration * 1.875
End Select
Select Case Nt
Case 1: Frequence = 261.63
Case 2: Frequence = 277.18
Case 3: Frequence = 293.66
Case 4: Frequence = 311.13
Case 5: Frequence = 329.63
Case 6: Frequence = 349.23
Case 7: Frequence = 369.99
Case 8: Frequence = 392.00
Case 9: Frequence = 415.30
Case 10: Frequence = 440.00
Case 11: Frequence = 466.16
Case 12: Frequence = 493.88
Case 13: Frequence = 0
End Select
Select Case Oct
Case 0: Frequence = Frequence / 4
Case 1: Frequence = Frequence / 2
Case 2: Frequence = Frequence
Case 3: Frequence = Frequence * 2
Case 4: Frequence = Frequence * 4
Case 5: Frequence = Frequence * 8
Case 6: Frequence = Frequence * 16
End Select
If Frequence = 0 Then
Sleep 18.2 * Duration
Else
If dRt = 2 Then
Sound CLng(Frequence), Duration
ElseIf dRt = 0 Then
Sound CLng(Frequence), Duration * 0.875
Sleep 18.2 * Duration * 0.125
Else
Sound CLng(Frequence), Duration * 0.750
Sleep 18.2 * Duration * 0.250
End If
End If
End If
Exit For
End Select
Next
i1 = i2
Loop
End Sub
Function PBMain()
' Song of Joy / Composed for Power Basic by Hanns Ackermann
Play "mnt130o1l2al4a+o2cco1a+agffgal3al8gl2g"
Sleep 3000
' La Cucaracha / Composed for Quick Basic by Jason Linett http://home.aol.com/SASEisME
Play "mnt120o4d7d9g9g9b9b9>d6<b5p9>d7e9d9c9<b9>d9c6<a5p9d7d9f#9f#9a9a9>c6<a9a5p9"
Play ">d7e9d9c9<b9a9g3d9d9d9g6b5d9d9d9g6b5p9g7g9f#9f#9e9e9d5d9d9d9f#6a7d9d9d9f#6a5p9>d7e9d9c9<b9a9g7p7d9d9d9g6b7d9d9d9g6b5p9g7g9f#9f#9e9e9d5d9d9d9f#6a7d9d9d9f#6a5p9>d7e9d 9c9<b9a9g3"
Sleep 3000
' Composed by ?
Play "mnt255o2c1d4f4e4d4g2g2g4a4e4f4d2d2d4f4e4d4c4o3c4o2b4a4g4f4e4d4c1d4f4e4d4g2g2g4a4e4f4d2d2d4f4e4d4c4g4d4e4c2p2"
Sleep 3000
' Composed by ?
MaryLamb
Sleep 3000
' Christmas tunes / Composed by Stephen Calvert
' Away in a Manger
Play "mnt100o3L4CC.L8<B-L4AA.L8GL4FFEDL2CL4CC.L8DL4CCGEDCFL2A>L4CC.L8<B-L4AA.L8GL4FFEDL2CL4CB-.L8AL4GAGFGDEL2F"
Sleep 3000
' Deck the Halls
Play "mnt255o2L4A.L8GL4F#EDEF#DL8EF#GEL4F#.L8EL4DC#L2DL4A.L8GL4F#EDEF#DL8EF#GEL4F#.L8EL4DC#L2DL4E.L8F#L4GEF#.L8GL4AEL8F#G#L4AL8B>C#L4DC#<BL2AL4A.L8GL4F#EDEF#DL8BBBBL4A.L8GL4F#EL2D "
Sleep 3000
' Joy to the World
Play "mst255O2L2>DL4C#.L8<BL2A.L4GL2F#ED.L4AL2B.L4B>L2C#.L4C#L2D.L4DDC#<BAA.L8GL4F#>DDC#<BAA.L8GL4F#F#F#F#L8F#GL2A.L8GF#L4EEEL8EF#L2G.L8F#EL4D>L2DL4<BA.L8GL4F#GL 2F#EL1D"
Sleep 3000
' Angels We Have Heard on High
Play "mnt150O2L4BBB>DD.L8C<L2BL4BAB>D<B.L8AL2GL4BBB>DD.L8C<L2BL4BAB>D<B.L8AL2GL2>DL8EDC<B>L2CL8DC<BAL2B>L8C<BAGL4A.L8DL2DL4GAB>C<L2BL4AP4 L2>DL8EDC<B>L2CL8DC<BAL2B>L8C<BAGL4A.L8DL2DL4GAB>C<L2BAG."
Sleep 3000
' Classic Beep
Sound 800, 13
Sleep 1500
' Microsoft demo samples for QBasic
' Bouncing
Bounce 32767, 246
Sleep 1500
' Falling
Fall 2000, 550, 500
Sleep 1500
' Klaxon
Klaxon 987, 329, 4
Sleep 1500
' Siren
Siren 780, 650, 4
End Function
#Compile Exe
#Register None
#Dim All
$Include "win32Api.Inc"
Sub Sound (Frequence As Long, Duration As Single)
Static IdOS%
If IdOS% = 0 Then
Dim os As OSVERSIONINFO
os.dwOSVersionInfoSize = SizeOf(os)
GetVersionEx ByVal VarPtr(os)
If (os.dwPlatformId = %VER_PLATFORM_WIN32_NT) <> 0 Then _
IdOS% = 1 Else IdOS% = 2
End If
Local Cnt??, x1?, x2?, DurationMSec As Long
If Frequence < 32 Or Frequence > 32767 Then Exit Sub
If Duration < 0.1 Or Duration > 65535 Then Exit Sub
DurationMSec = 1000 / 18.2 * Duration
If IdOS% = 1 Then
WinBeep Frequence, DurationMSec
Else
Cnt?? = 1193180 / Frequence
x1? = LoByt(Cnt??)
x2? = HiByt(Cnt??)
! MOV AL, &HB6
! OUT &H43, AL
! MOV AL, x1?
! OUT &H42, AL
! MOV AL, x2?
! OUT &H42, AL
! In AL, &H61
! OR AL, 3
! OUT &H61, AL
Sleep DurationMSec
! In AL, &H61
! AND AL, &HFD
! OUT &H61, AL
End If
End Sub
' Loop two sounds down at decreasing time intervals
Sub Bounce (Hi As Long, Low As Long)
Local Count As Long
For Count = 60 To 1 Step -2
Sound Low - Count / 2, Count / 20
Sound Hi, Count / 15
Next
End Sub
' Loop down from a high sound to a low sound
Sub Fall (Hi As Long, Low As Long, Del As Long)
Local Count As Long
For Count = Hi To Low Step -10
Sound Count, Del / Count
Next
End Sub
' Alternate two sounds until a key is pressed
Sub Klaxon (Hi As Long, Low As Long, Nmb As Long)
Local Count As Long
For Count = 1 To Nmb
Sound Hi, 5: Sound Low, 5
Next
End Sub
' Loop a sound from low to high to low
Sub Siren (Hi As Long, Range As Long, Nmb As Long)
Local Count1 As Long, Count2 As Long
For Count1 = 1 To Nmb
Count2 = Range
Do
If Count2 < -Range Then Exit Do
Sound Hi - Abs(Count2), .3
Count2 = Count2 - 2 / Range
Count2 = Count2 - 4
Loop
Next
End Sub
' Song
Sub MaryLamb
Sound 330, 5: Sound 294, 5: Sound 262, 5: Sound 294, 5
Sound 330, 5: Sound 330, 5: Sound 330, 10
Sound 294, 5: Sound 294, 5: Sound 294, 10: Sound 330, 5
Sound 392, 5: Sound 392, 10: Sound 330, 5
Sound 294, 5: Sound 262, 5: Sound 294, 5: Sound 330, 5
Sound 330, 5: Sound 330, 5: Sound 330, 5
Sound 294, 5: Sound 294, 5: Sound 330, 5
Sound 294, 5: Sound 262, 5
End Sub
Sub Play (Music$)
Static Takts As Long, dOct As Long, dLong As Long, dRt As Long
Local w$, i As Long, j As Long, Dt As Long, Nmb As Long, Nt As Long, Oct As Long
Local Frequence As Single, Duration As Single
Local LMusic As Long, Op$, i1 As Long, i2 As Long, k As Long
If Takts = 0 Then dOct = 4: Takts = 120: dLong = 1
Music$ = UCase$(Music$): LMusic = Len(Music$): i1 = 1
Do
If i1 > LMusic Then Exit Do
i2 = i1 + 1
Do
If i2 > LMusic Then Exit Do
j = InStr("CDEFGABOLPTMN<> ", Mid$(Music$, i2, 1)): If j > 0 Then Exit Do
Incr i2
Loop
Op$ = Mid$(Music$, i1, i2 - i1)
Nmb = 0: Dt = 0
For k = Len(Op$) To 1 Step -1
j = Asc(Op$, k)
Select Case j
Case 46: If Nmb > 0 Then Exit For Else Incr Dt
Case 48 To 57: Incr Nmb
Case Else
If Nmb > 0 Then Nmb = Val(Mid$(Op$, k + 1, Nmb)): If Nmb = 0 Then Exit For
Select Case Left$(Op$, k)
Case "C": Nt = 1
Case "C+", "C#", "D-": Nt = 2
Case "D": Nt = 3
Case "D+", "D#", "E-": Nt = 4
Case "E": Nt = 5
Case "F": Nt = 6
Case "F+", "F#", "G-": Nt = 7
Case "G": Nt = 8
Case "G+", "G#", "A-": Nt = 9
Case "A": Nt = 10
Case "A+", "A#", "B-": Nt = 11
Case "B": Nt = 12
Case "P": Nt = 13
Case "N": If Nmb > 84 Then Exit For Else Nt = 14
Case "T"
If Nmb >= 32 And Nmb <= 255 Then Takts = Nmb
Exit For
Case "L"
If Nmb >= 1 And Nmb <= 64 Then dLong = Nmb
Exit For
Case "O"
If Nmb <= 6 Then dOct = Nmb
Exit For
Case "<"
If Nmb = 0 Then Nmb = 1
dOct = dOct - Nmb
If dOct < 0 Then dOct = 0
Exit For
Case ">"
If Nmb = 0 Then Nmb = 1
dOct = dOct + Nmb
If dOct > 6 Then dOct = 6
Exit For
Case "MN": dRt = 0: Exit For
Case "MS": dRt = 1: Exit For
Case "ML": dRt = 2: Exit For
Case Else: Exit For
End Select
If Nt >= 1 And Nt <= 14 Then
If Nt = 14 Then
If Nmb = 0 Then Nt = 13 Else Oct = Fix((Nmb - 1) / 12): Nt = Nmb - 12 * Oct
Nmb = 0
Else
If Nmb < 0 Or Nmb > 64 Then Exit Do
Oct = dOct
End If
If Nmb = 0 Then Nmb = dLong
Duration = 1092 / Takts / Nmb * 4
Select Case Dt
Case 1: Duration = Duration * 1.5
Case 2: Duration = Duration * 1.75
Case >= 3: Duration = Duration * 1.875
End Select
Select Case Nt
Case 1: Frequence = 261.63
Case 2: Frequence = 277.18
Case 3: Frequence = 293.66
Case 4: Frequence = 311.13
Case 5: Frequence = 329.63
Case 6: Frequence = 349.23
Case 7: Frequence = 369.99
Case 8: Frequence = 392.00
Case 9: Frequence = 415.30
Case 10: Frequence = 440.00
Case 11: Frequence = 466.16
Case 12: Frequence = 493.88
Case 13: Frequence = 0
End Select
Select Case Oct
Case 0: Frequence = Frequence / 4
Case 1: Frequence = Frequence / 2
Case 2: Frequence = Frequence
Case 3: Frequence = Frequence * 2
Case 4: Frequence = Frequence * 4
Case 5: Frequence = Frequence * 8
Case 6: Frequence = Frequence * 16
End Select
If Frequence = 0 Then
Sleep 18.2 * Duration
Else
If dRt = 2 Then
Sound CLng(Frequence), Duration
ElseIf dRt = 0 Then
Sound CLng(Frequence), Duration * 0.875
Sleep 18.2 * Duration * 0.125
Else
Sound CLng(Frequence), Duration * 0.750
Sleep 18.2 * Duration * 0.250
End If
End If
End If
Exit For
End Select
Next
i1 = i2
Loop
End Sub
Function PBMain()
' Song of Joy / Composed for Power Basic by Hanns Ackermann
Play "mnt130o1l2al4a+o2cco1a+agffgal3al8gl2g"
Sleep 3000
' La Cucaracha / Composed for Quick Basic by Jason Linett http://home.aol.com/SASEisME
Play "mnt120o4d7d9g9g9b9b9>d6<b5p9>d7e9d9c9<b9>d9c6<a5p9d7d9f#9f#9a9a9>c6<a9a5p9"
Play ">d7e9d9c9<b9a9g3d9d9d9g6b5d9d9d9g6b5p9g7g9f#9f#9e9e9d5d9d9d9f#6a7d9d9d9f#6a5p9>d7e9d9c9<b9a9g7p7d9d9d9g6b7d9d9d9g6b5p9g7g9f#9f#9e9e9d5d9d9d9f#6a7d9d9d9f#6a5p9>d7e9d 9c9<b9a9g3"
Sleep 3000
' Composed by ?
Play "mnt255o2c1d4f4e4d4g2g2g4a4e4f4d2d2d4f4e4d4c4o3c4o2b4a4g4f4e4d4c1d4f4e4d4g2g2g4a4e4f4d2d2d4f4e4d4c4g4d4e4c2p2"
Sleep 3000
' Composed by ?
MaryLamb
Sleep 3000
' Christmas tunes / Composed by Stephen Calvert
' Away in a Manger
Play "mnt100o3L4CC.L8<B-L4AA.L8GL4FFEDL2CL4CC.L8DL4CCGEDCFL2A>L4CC.L8<B-L4AA.L8GL4FFEDL2CL4CB-.L8AL4GAGFGDEL2F"
Sleep 3000
' Deck the Halls
Play "mnt255o2L4A.L8GL4F#EDEF#DL8EF#GEL4F#.L8EL4DC#L2DL4A.L8GL4F#EDEF#DL8EF#GEL4F#.L8EL4DC#L2DL4E.L8F#L4GEF#.L8GL4AEL8F#G#L4AL8B>C#L4DC#<BL2AL4A.L8GL4F#EDEF#DL8BBBBL4A.L8GL4F#EL2D "
Sleep 3000
' Joy to the World
Play "mst255O2L2>DL4C#.L8<BL2A.L4GL2F#ED.L4AL2B.L4B>L2C#.L4C#L2D.L4DDC#<BAA.L8GL4F#>DDC#<BAA.L8GL4F#F#F#F#L8F#GL2A.L8GF#L4EEEL8EF#L2G.L8F#EL4D>L2DL4<BA.L8GL4F#GL 2F#EL1D"
Sleep 3000
' Angels We Have Heard on High
Play "mnt150O2L4BBB>DD.L8C<L2BL4BAB>D<B.L8AL2GL4BBB>DD.L8C<L2BL4BAB>D<B.L8AL2GL2>DL8EDC<B>L2CL8DC<BAL2B>L8C<BAGL4A.L8DL2DL4GAB>C<L2BL4AP4 L2>DL8EDC<B>L2CL8DC<BAL2B>L8C<BAGL4A.L8DL2DL4GAB>C<L2BAG."
Sleep 3000
' Classic Beep
Sound 800, 13
Sleep 1500
' Microsoft demo samples for QBasic
' Bouncing
Bounce 32767, 246
Sleep 1500
' Falling
Fall 2000, 550, 500
Sleep 1500
' Klaxon
Klaxon 987, 329, 4
Sleep 1500
' Siren
Siren 780, 650, 4
End Function
'gbs_00414
'Date: 05-11-2013
http://www.garybeene.com/sw/gbsnippets.htm