74 lines
1.9 KiB
Plaintext
74 lines
1.9 KiB
Plaintext
REM FreeBASIC no tiene la capacidad de emitir sonido de forma nativa.
|
|
REM La función Sound no es mía, incluyo los créditos correspondientes.
|
|
' Sound Function v0.3 For DOS/Linux/Win by yetifoot
|
|
' Credits:
|
|
' http://www.frontiernet.net/~fys/snd.htm
|
|
' http://delphi.about.com/cs/adptips2003/a/bltip0303_3.htm
|
|
#ifdef __FB_WIN32__
|
|
#include Once "windows.bi"
|
|
#endif
|
|
Sub Sound_DOS_LIN(Byval freq As Uinteger, dur As Uinteger)
|
|
Dim t As Double
|
|
Dim As Ushort fixed_freq = 1193181 \ freq
|
|
|
|
Asm
|
|
mov dx, &H61 ' turn speaker on
|
|
in al, dx
|
|
or al, &H03
|
|
out dx, al
|
|
mov dx, &H43 ' get the timer ready
|
|
mov al, &HB6
|
|
out dx, al
|
|
mov ax, word Ptr [fixed_freq] ' move freq to ax
|
|
mov dx, &H42 ' port to out
|
|
out dx, al ' out low order
|
|
xchg ah, al
|
|
out dx, al ' out high order
|
|
End Asm
|
|
|
|
t = Timer
|
|
While ((Timer - t) * 1000) < dur ' wait for out specified duration
|
|
Sleep(1)
|
|
Wend
|
|
|
|
Asm
|
|
mov dx, &H61 ' turn speaker off
|
|
in al, dx
|
|
and al, &HFC
|
|
out dx, al
|
|
End Asm
|
|
End Sub
|
|
|
|
Sub Sound(Byval freq As Uinteger, dur As Uinteger)
|
|
#ifndef __fb_win32__
|
|
' If not windows Then call the asm version.
|
|
Sound_DOS_LIN(freq, dur)
|
|
#Else
|
|
' If Windows
|
|
Dim osv As OSVERSIONINFO
|
|
|
|
osv.dwOSVersionInfoSize = Sizeof(OSVERSIONINFO)
|
|
GetVersionEx(@osv)
|
|
|
|
Select Case osv.dwPlatformId
|
|
Case VER_PLATFORM_WIN32_NT
|
|
' If NT then use Beep from API
|
|
Beep_(freq, dur)
|
|
Case Else
|
|
' If not on NT then use the same as DOS/Linux
|
|
Sound_DOS_LIN(freq, dur)
|
|
End Select
|
|
#endif
|
|
End Sub
|
|
|
|
'----------
|
|
Sound(262, 250) 'C4
|
|
Sound(294, 250) 'D4
|
|
Sound(330, 250) 'E4
|
|
Sound(349, 250) 'F4
|
|
Sound(392, 250) 'G4
|
|
Sound(440, 250) 'A4
|
|
Sound(494, 250) 'B4
|
|
Sound(523, 250) 'C5
|
|
Sleep
|