Option Explicit
Dim Sample As Double
Dim DX As DirectX8 '
Dim DS As DirectSound8
Dim Tone(21) As DirectSoundSecondaryBuffer8
Dim dsToneBuffer As DirectSoundSecondaryBuffer8
Dim desc As DSBUFFERDESC
Const PI = 3.14159265358979
Const SRATE = 44100 ' sampling data per detik
Const DUR = 1 ' durasi nada
Const FREQ = 440 ' frekuensi acuan
Const CHAN = 2 ' stereo / 2 channel
Const BITDEPTH = 16 ' 16 bit
Const BLOCK = 4
Dim sbuf(0 To DUR * SRATE * CHAN) As Integer
Dim tekan(255) As Boolean
Dim poly As Integer
Dim frekNote As Long
Dim nfreq As Integer
Private Sub Form_Load()
KeyPreview = True
Set DX = New DirectX8
Set DS = DX.DirectSoundCreate("")
DS.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
desc.fxFormat.nFormatTag = WAVE_FORMAT_PCM ' format audio
desc.fxFormat.nSize = 0
'desc.fxFormat.lExtra = 0
desc.fxFormat.nChannels = CHAN
desc.fxFormat.lSamplesPerSec = SRATE
desc.fxFormat.nBitsPerSample = BITDEPTH
desc.fxFormat.nBlockAlign = BLOCK
desc.fxFormat.lAvgBytesPerSec = BLOCK * SRATE
desc.lFlags = DSBCAPS_STATIC Or DSBCAPS_CTRLVOLUME Or DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN
desc.lBufferBytes = BLOCK * DUR * SRATE
Set dsToneBuffer = DS.CreateSoundBuffer(desc)
Dim i ' pembuatan nada
Dim n
For i = 0 To DUR * SRATE - 1
n = 2 * PI * (FREQ * i / SRATE)
Sample = Sin(n) + Sin(2 * n)
sbuf(2 * i) = Sample * 0.25 * 32767
sbuf(2 * i + 1) = sbuf(2 * i)
Next i
For i = 0 To 21
Set Tone(i) = DS.CreateSoundBuffer(desc)
Tone(i).WriteBuffer 0, BLOCK * DUR * SRATE, sbuf(0), DSBLOCK_DEFAULT
Next
End Sub
'uji penekanan tombol
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyQ Then nfreq = 262: poly = 1
If KeyCode = vbKeyW Then nfreq = 294: poly = 2
If KeyCode = vbKeyE Then nfreq = 330: poly = 3
If KeyCode = vbKeyR Then nfreq = 349: poly = 4
If KeyCode = vbKeyT Then nfreq = 392: poly = 5
If KeyCode = vbKeyY Then nfreq = 440: poly = 6
If KeyCode = vbKeyU Then nfreq = 495: poly = 7
If KeyCode = vbKeyI Then nfreq = 524: poly = 8
If KeyCode = vbKeyZ Then nfreq = 262 / 2: poly = 9
If KeyCode = vbKeyX Then nfreq = 294 / 2: poly = 10
If KeyCode = vbKeyC Then nfreq = 330 / 2: poly = 11
If KeyCode = vbKeyV Then nfreq = 349 / 2: poly = 12
If KeyCode = vbKeyB Then nfreq = 392 / 2: poly = 13
If KeyCode = vbKeyN Then nfreq = 440 / 2: poly = 14
If KeyCode = vbKeyM Then nfreq = 495 / 2: poly = 15
If KeyCode = 188 Then nfreq = 262: poly = 16
If KeyCode = vbKeyO Then nfreq = 294 * 2: poly = 17
If KeyCode = vbKeyP Then nfreq = 330 * 2: poly = 18
If KeyCode = 219 Then nfreq = 349 * 2: poly = 19
If KeyCode = 221 Then nfreq = 392 * 2: poly = 20
If KeyCode = 220 Then nfreq = 440 * 2: poly = 21
If Not tekan(KeyCode) And nfreq <> 0 Then
tekan(KeyCode) = True
Tone(poly).SetVolume -10000
frekNote = (nfreq / FREQ) * 44100
Tone(poly).SetFrequency frekNote
Tone(poly).SetCurrentPosition 0
Tone(poly).Play 1
Tone(poly).SetVolume -500
End If
End Sub
Private Sub PlayIt()
End Sub
'uji pelepasan tombol
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyQ Then tekan(vbKeyQ) = False: poly = 1: StopIt
If KeyCode = vbKeyW Then tekan(vbKeyW) = False: poly = 2: StopIt
If KeyCode = vbKeyE Then tekan(vbKeyE) = False: poly = 3: StopIt
If KeyCode = vbKeyR Then tekan(vbKeyR) = False: poly = 4: StopIt
If KeyCode = vbKeyT Then tekan(vbKeyT) = False: poly = 5: StopIt
If KeyCode = vbKeyY Then tekan(vbKeyY) = False: poly = 6: StopIt
If KeyCode = vbKeyU Then tekan(vbKeyU) = False: poly = 7: StopIt
If KeyCode = vbKeyI Then tekan(vbKeyI) = False: poly = 8: StopIt
If KeyCode = vbKeyZ Then tekan(vbKeyZ) = False: poly = 9: StopIt
If KeyCode = vbKeyX Then tekan(vbKeyX) = False: poly = 10: StopIt
If KeyCode = vbKeyC Then tekan(vbKeyC) = False: poly = 11: StopIt
If KeyCode = vbKeyV Then tekan(vbKeyV) = False: poly = 12: StopIt
If KeyCode = vbKeyB Then tekan(vbKeyB) = False: poly = 13: StopIt
If KeyCode = vbKeyN Then tekan(vbKeyN) = False: poly = 14: StopIt
If KeyCode = vbKeyM Then tekan(vbKeyM) = False: poly = 15: StopIt
If KeyCode = 188 Then tekan(188) = False: poly = 16: StopIt
If KeyCode = vbKeyO Then tekan(vbKeyO) = False: poly = 17: StopIt
If KeyCode = vbKeyP Then tekan(vbKeyP) = False: poly = 18: StopIt
If KeyCode = 219 Then tekan(219) = False: poly = 19: StopIt
If KeyCode = 221 Then tekan(221) = False: poly = 20: StopIt
If KeyCode = 220 Then tekan(220) = False: poly = 21: StopIt
End Sub
Private Sub StopIt()
Tone(poly).SetVolume -10000
nfreq = 0: poly =
End Sub
Sebelum menekan tombol F5, lakukan langkah berikut : Project -> References -> Pilih DirectX 8 for Visual Basic Type Library
Selamat Berkreasi ..!
09.31
yulisriyadi
Posted in: Tugas
