Membuat Beat Box Drummer dengan Visual Basic 6

Buatlah Form seperti gambar di ini  jangan lupa masukan sebuah Timer kemudian ganti namanya dengan nama Timer1 dan buatlah properti Enable=True dan Interval=10. Serta jangan lupa menggunakan pustaka directX 8.

Selanjutnya salin program berikut ini, selamat berkreasi


'Membuat Beat Box Drummer dengan Visual Basic 6

Option Explicit
Dim OneSample  As Double
Dim DX As New DirectX8 ' menggunakan directx 8
Dim DS As DirectSound8
Dim Bass As DirectSoundSecondaryBuffer8
Dim Snare As DirectSoundSecondaryBuffer8
Dim Hat 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 hitung As Long
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 Bass = DS.CreateSoundBuffer(desc)  '  membuat buffer
Dim i    ' pembuatan frekuensi suara
Dim n, n2, n3, x
Dim env As Double

mksoundata 50, -30, 0.1, 40, 4, 0.1, 0.15, Bass, "Saw"
mksoundata 350, -250, 0.2, 100, 0, 0, 0.1, Snare, "Square"
mksoundata 18000, -10, 0.5, 7500, 0, 0.1, 0.1, Hat, "Noise"


End Sub

Private Sub Timer1_Timer()

If hitung = 0 Or hitung = 8 Or hitung = 16 Or hitung = 56 Or hitung = 88 Or hitung = 80 Then
Bass.SetVolume -10000
If Bass.GetStatus = DSBSTATUS_PLAYING Then Bass.Stop: Bass.SetCurrentPosition 0
Bass.SetVolume -1000
Bass.Play 0
End If

If hitung = 32 Or hitung = 96 Or hitung = 120 Then
Snare.SetVolume -10000
If Snare.GetStatus = DSBSTATUS_PLAYING Then Snare.Stop: Snare.SetCurrentPosition 0
Snare.SetVolume -1500
Snare.Play 0
End If

If hitung = 0 Or hitung = 16 Or hitung = 32 Or hitung = 48 Or hitung = 64 Or hitung = 80 Or hitung = 96 Or hitung = 104 Or hitung = 112 Then
Hat.SetVolume -10000
If Hat.GetStatus = DSBSTATUS_PLAYING Then Hat.Stop: Hat.SetCurrentPosition 0
Hat.SetVolume -1500

Hat.Play 0
Hat.SetPan 0

End If


hitung = hitung + 1
If hitung > 128 Then hitung = 0
End Sub


Private Sub mksoundata(f1 As Integer, swp1 As Integer, stime1 As Single, _
                       f2 As Integer, swp2 As Integer, stime2 As Single, _
                       dec As Single, Buff As DirectSoundSecondaryBuffer8, Optional waveform As String = "Sine")
Dim i, shift1, shift2, n, n2, n3, env, wavelength
'Dim Buff As New DirectSoundSecondaryBuffer8
env = 1
wavelength = SRATE / f1
For i = 0 To DUR * SRATE - 1
n = 2 * PI * ((f1 + shift1) * i / SRATE)
'n2 = 2 * PI * ((f2 + shift2) * i / SRATE)

env = IIf(i < dec * SRATE, 1 - (i / (dec * SRATE)), 0)
shift1 = IIf(i < dec * SRATE, swp1 * (i / (dec * SRATE)), 0)
shift2 = IIf(i < dec * SRATE, swp2 * (i / (dec * SRATE)), 0)

    Select Case waveform
    Case "Sine"  ' gelombang sinus -- sin(n)
        OneSample = Sin(n + Sin(n + Sin(n + Sin(n)))) * env ' frekunsinya sudah dimodulasi
   
    Case "Square"
        OneSample = Sgn(Sin(n)) * env
    Case "Saw"
        OneSample = ((i Mod wavelength) / wavelength) * env
    Case "Triangle"
        OneSample = Abs(1 - ((i Mod wavelength) / wavelength) * 2) * env
    Case "Noise"
        OneSample = (Rnd - Rnd) * env
    End Select

    sbuf(2 * i) = OneSample * 32767 * 0.55 * env ' chanel kiri
    sbuf(2 * i + 1) = sbuf(2 * i)     ' chanel kanan copy dari chanel kiri
Next i

Set Buff = DS.CreateSoundBuffer(desc)
Buff.WriteBuffer 0, BLOCK * DUR * SRATE, sbuf(0), DSBLOCK_DEFAULT 'mengisi buffer
End Sub

Read more »

Posted in: Pemrograman,Pemrograman Audio

Membuat Piano Mouse (Visual Basic)

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

Read more »

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

Membuat Frekuensi Suara (Visual Basic)

Buatlah Tampilan Form seperti berikut :

Read more »

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

Pemrograman Audio / Musik - Basic Synthesizer / Piano (Visual Basic)

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 ..!

Read more »

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