Membuat Piano Mouse (Visual Basic)

Buatlah 1 Buah Command  Button, kemudian copy hingga menjadi 24 setelah itu beri nomor index 0-23






Option Explicit
'Piano ini akan berbunyi dengan cara mengklik tombol dengan Mouse
'yulisriyadi.blogspot.com    email :  y_riyadi@yahoo.com
 Dim OneSample  As Double

Dim DX As DirectX8 ' menggunakan directx 8
Dim DS As DirectSound8
Dim BufferSuara As DirectSoundSecondaryBuffer8
Dim desc As DSBUFFERDESC

Const PI = 3.14159265358979
Const SRATE = 44100         ' Kecepatan Sample / sampling rate
Const DUR = 1                  ' Durasi suara
Const FREQ = 440               ' referensi frekuensisuara
Const CHAN = 2                   ' stereo
Const BITDEPTH = 16              ' 16 bit
Const BLOCK = 4
Dim sbuf(0 To DUR * SRATE * CHAN) As Integer

Private Sub Form_Load()

Set DX = New DirectX8   ' menggunkan directx 8
Set DS = DX.DirectSoundCreate("")
DS.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
desc.fxFormat.nFormatTag = WAVE_FORMAT_PCM  ' header audio wav
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 BufferSuara = DS.CreateSoundBuffer(desc)  '  membuat buffer
Dim i    ' pembuatan frekuensi suara
Dim n
For i = 0 To DUR * SRATE - 1

n = 2 * PI * ((FREQ) * i / SRATE)


    OneSample =  Sin(n)

    sbuf(2 * i) = OneSample * 32767 ' chanel kiri
    sbuf(2 * i + 1) = sbuf(2 * i)     ' chanel kanan

Next i
BufferSuara.WriteBuffer 0, BLOCK * DUR * SRATE, sbuf(0), DSBLOCK_DEFAULT 'mengisi buffer

End Sub
Private Sub Command1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
BufferSuara.SetFrequency SRATE * 440 * 2 ^ ((Index - 12) / 12) / FREQ '----mengubah frekuensi
BufferSuara.SetVolume -1500
BufferSuara.Play 1  ' mainkan suara
End Sub

Private Sub Command1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
BufferSuara.SetVolume -10000
BufferSuara.Stop  'stop suara
End Sub

Posted in: Membuat Musik,Musik Komputer,Pemrograman,Pemrograman Audio