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

Posted in: Pemrograman,Pemrograman Audio