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

Seri Motivasi : Dibalik semua kejadian buruk pasti ada hikmah.

Pernahkan anda mengalami hal terburuk yang terjadi pada diri anda atau dalam kehidupan anda sendiri?  Jawabannya mungkin ya ataupun tidak, tetapi yang paling penting disini adalah kita harus bisa memahami sebuah hikmah yang dapat kita ambil dari hal buruk yang pernah kita alami sebagai sebuah proses pembelajaran yang bisa meningkatkan kualitas mental anda dalam melewati berbagai cobaan kehidupan sehingga lebih memberikan makna yang lebih luas akan pemahaman sebuah proses tersebut.   
 

Hikmah yang bisa kita ambil dari setiap kejadian yang menimpa kita adalah ada maksud tersembunyi dibalik kejadian ini dari Sang Pencipta yang membuat kita lebih bersyukur karena mungkin saja kejadian yang kita alami tersebut mencegah kita dari kejadian yang lebih buruk yang bisa saja kita alami.

Misalnya  seseorang pernah kehilangan kendaraan yang sangat ia senangi dan sangat membantunya dalam kehidupan sehari-hari, padahal kendaran tersebut sangat berharga baginya dalam meraih penghidupan tetapi karena sebuah sebab kendaraan tadi hilang dicuri orang. Sang pemilik kendaraan tersebut sangat kecewa karena harta miliknya lenyap begitu saja sementara ia tidak bisa melakukan kegiatan lainnya. Setelah beberapa jam kemudian kendaraan tersebut ditemukan dalam keadaan rusak parah dan pengendaranya dikabarkan mengalami kematian karena benturan dua kendaraan yang sangat keras. Pemilik kendaran sangat bersyukur karena kalau tidak kehilangan kendaraannya, mungkin saja ia yang menjadi korban kecelakaan tersebut.

Read more »

Posted in: Menulis,motivasi