176 lines
6.2 KiB
Text
176 lines
6.2 KiB
Text
|
VERSION 5.00
|
||
|
|
Begin VB.Form frmSynth
|
||
|
|
BorderStyle = 3 'Fixed Dialog
|
||
|
|
Caption = "BASS Simple Sinewave Synth"
|
||
|
|
ClientHeight = 3375
|
||
|
|
ClientLeft = 45
|
||
|
|
ClientTop = 435
|
||
|
|
ClientWidth = 4350
|
||
|
|
BeginProperty Font
|
||
|
|
Name = "Arial"
|
||
|
|
Size = 9.75
|
||
|
|
Charset = 177
|
||
|
|
Weight = 400
|
||
|
|
Underline = 0 'False
|
||
|
|
Italic = 0 'False
|
||
|
|
Strikethrough = 0 'False
|
||
|
|
EndProperty
|
||
|
|
LinkTopic = "Form1"
|
||
|
|
MaxButton = 0 'False
|
||
|
|
MinButton = 0 'False
|
||
|
|
ScaleHeight = 225
|
||
|
|
ScaleMode = 3 'Pixel
|
||
|
|
ScaleWidth = 290
|
||
|
|
StartUpPosition = 2 'CenterScreen
|
||
|
|
Begin VB.Label lblWinTxt
|
||
|
|
Height = 855
|
||
|
|
Left = 0
|
||
|
|
TabIndex = 0
|
||
|
|
Top = 2520
|
||
|
|
Width = 4335
|
||
|
|
End
|
||
|
|
End
|
||
|
|
Attribute VB_Name = "frmSynth"
|
||
|
|
Attribute VB_GlobalNameSpace = False
|
||
|
|
Attribute VB_Creatable = False
|
||
|
|
Attribute VB_PredeclaredId = True
|
||
|
|
Attribute VB_Exposed = False
|
||
|
|
'//////////////////////////////////////////////////////////////////////////////
|
||
|
|
' frmSynth.frm - Copyright (c) 2006-2007 (: JOBnik! :) [Arthur Aminov, ISRAEL]
|
||
|
|
' [http://www.jobnik.org]
|
||
|
|
' [ jobnik@jobnik.org ]
|
||
|
|
'
|
||
|
|
' Other source: modSynth.bas
|
||
|
|
'
|
||
|
|
' BASS Simple Synth
|
||
|
|
' Originally translated from - synth.c - Example of Ian Luck
|
||
|
|
'//////////////////////////////////////////////////////////////////////////////
|
||
|
|
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
Dim str As Long
|
||
|
|
Dim fx(9) As Long ' effect handles
|
||
|
|
Dim r As Long, buflen As Long
|
||
|
|
Dim fxname As Variant
|
||
|
|
|
||
|
|
' display error messages
|
||
|
|
Sub Error_(ByVal es As String)
|
||
|
|
Call MsgBox(es & vbCrLf & vbCrLf & "error code: " & BASS_ErrorGetCode, vbExclamation, "Error")
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_Load()
|
||
|
|
' change and set the current path, to prevent from VB not finding BASS.DLL
|
||
|
|
ChDrive App.Path
|
||
|
|
ChDir App.Path
|
||
|
|
|
||
|
|
fxname = Array("CHORUS", "COMPRESSOR", "DISTORTION", "ECHO", "FLANGER", "GARGLE", "I3DL2REVERB", "PARAMEQ", "REVERB")
|
||
|
|
keys = Array("Q", "2", "W", "3", "E", "R", "5", "T", "6", "Y", "7", "U", "I", "9", "O", "0", "P", 219, 187, 221)
|
||
|
|
|
||
|
|
' check the correct BASS was loaded
|
||
|
|
If (HiWord(BASS_GetVersion()) <> BASSVERSION) Then
|
||
|
|
Call Error_("An incorrect version of BASS.DLL was loaded")
|
||
|
|
End
|
||
|
|
End If
|
||
|
|
|
||
|
|
' 10ms update period
|
||
|
|
Call BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10)
|
||
|
|
|
||
|
|
' setup output - get latency
|
||
|
|
If (BASS_Init(-1, 44100, BASS_DEVICE_LATENCY, 0, 0) = 0) Then
|
||
|
|
Call Error_("Can't initialize device")
|
||
|
|
End
|
||
|
|
End If
|
||
|
|
|
||
|
|
' build sine table
|
||
|
|
For r = 0 To TABLESIZE - 1
|
||
|
|
sinetable(r) = CLng(Sin(2# * PI * CDbl(r) / TABLESIZE) * 7000#)
|
||
|
|
Next r
|
||
|
|
|
||
|
|
Call BASS_GetInfo(info)
|
||
|
|
' default buffer size = update period + 'minbuf'
|
||
|
|
Call BASS_SetConfig(BASS_CONFIG_BUFFER, 10 + info.minbuf)
|
||
|
|
buflen = BASS_GetConfig(BASS_CONFIG_BUFFER)
|
||
|
|
' if the device's output rate is unknown default to 44100 Hz
|
||
|
|
If (info.freq = 0) Then info.freq = 44100
|
||
|
|
' create a stream, stereo so that effects sound nice
|
||
|
|
str = BASS_StreamCreate(info.freq, 2, 0, AddressOf WriteStream, 0)
|
||
|
|
|
||
|
|
Me.AutoRedraw = True
|
||
|
|
Me.KeyPreview = True
|
||
|
|
|
||
|
|
Print "device latency: " & info.latency & "ms"
|
||
|
|
Print "device minbuf : " & info.minbuf & "ms"
|
||
|
|
Print "ds version: " & info.dsver & " (effects " & IIf(info.dsver < 8, "disabled", "enabled") & ")"
|
||
|
|
Print "press these keys to play:" & vbCrLf
|
||
|
|
Print " 2 3 5 6 7 9 0 ="
|
||
|
|
Print " Q W ER T Y UI O P[ ]" & vbCrLf
|
||
|
|
Print "press -/+ to de/increase the buffer"
|
||
|
|
Print "press spacebar to quit" & vbCrLf
|
||
|
|
If (info.dsver >= 8) Then ' DX8 effects available
|
||
|
|
Print "press F1-F9 to toggle effects" & vbCrLf
|
||
|
|
End If
|
||
|
|
lblWinTxt.Caption = "using a " & buflen & "ms buffer"
|
||
|
|
|
||
|
|
Call BASS_ChannelPlay(str, BASSFALSE)
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
|
||
|
|
If (KeyCode = vbKeySpace) Then Call Unload(Me)
|
||
|
|
|
||
|
|
If (KeyCode = vbKeySubtract Or KeyCode = vbKeyAdd) Then
|
||
|
|
' recreate stream with smaller/larger buffer
|
||
|
|
Call BASS_StreamFree(str)
|
||
|
|
If (KeyCode = vbKeySubtract) Then
|
||
|
|
Call BASS_SetConfig(BASS_CONFIG_BUFFER, buflen - 1) ' smaller buffer
|
||
|
|
Else
|
||
|
|
Call BASS_SetConfig(BASS_CONFIG_BUFFER, buflen + 1) ' larger buffer
|
||
|
|
End If
|
||
|
|
buflen = BASS_GetConfig(BASS_CONFIG_BUFFER)
|
||
|
|
lblWinTxt.Caption = "using a " & buflen & "ms buffer"
|
||
|
|
str = BASS_StreamCreate(info.freq, 2, 0, AddressOf WriteStream, 0)
|
||
|
|
' set effects on the new stream
|
||
|
|
For r = 0 To 9
|
||
|
|
If (fx(r)) Then fx(r) = BASS_ChannelSetFX(str, BASS_FX_DX8_CHORUS + r, 0)
|
||
|
|
Next r
|
||
|
|
Call BASS_ChannelPlay(str, BASSFALSE)
|
||
|
|
End If
|
||
|
|
|
||
|
|
If (KeyCode >= vbKeyF1 And KeyCode <= vbKeyF9) Then
|
||
|
|
r = KeyCode - vbKeyF1
|
||
|
|
If (fx(r)) Then
|
||
|
|
Call BASS_ChannelRemoveFX(str, fx(r))
|
||
|
|
fx(r) = 0
|
||
|
|
lblWinTxt.Caption = "effect " & fxname(r) & " = OFF"
|
||
|
|
Else
|
||
|
|
' set the effect, not bothering with parameters (use defaults)
|
||
|
|
fx(r) = BASS_ChannelSetFX(str, BASS_FX_DX8_CHORUS + r, 0)
|
||
|
|
If (fx(r)) Then lblWinTxt.Caption = "effect " & fxname(r) & " = ON"
|
||
|
|
End If
|
||
|
|
End If
|
||
|
|
|
||
|
|
Dim key As Long
|
||
|
|
For key = 0 To KEYS_ - 1
|
||
|
|
If (KeyCode = keys(key) Or KeyCode = Asc(keys(key))) Then Exit For
|
||
|
|
Next key
|
||
|
|
If (key <> KEYS_) Then
|
||
|
|
If (KeyCode And (vol(key) <> MAXVOL)) Then
|
||
|
|
pos(key) = 0
|
||
|
|
vol(key) = MAXVOL ' start key
|
||
|
|
ElseIf ((KeyCode = 0) And vol(key)) Then
|
||
|
|
vol(key) = vol(key) - 1 ' trigger key fadeout
|
||
|
|
End If
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
|
||
|
|
Dim key As Long
|
||
|
|
For key = 0 To KEYS_ - 1
|
||
|
|
If (KeyCode = keys(key) Or KeyCode = Asc(keys(key))) Then Exit For
|
||
|
|
Next key
|
||
|
|
If (key <> KEYS_) Then vol(key) = vol(key) - 1 ' trigger key fadeout
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub Form_Unload(Cancel As Integer)
|
||
|
|
BASS_Free
|
||
|
|
End Sub
|