294 lines
9 KiB
Text
294 lines
9 KiB
Text
VERSION 5.00
|
|
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
|
|
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
|
|
Begin VB.Form frmFXtest
|
|
BorderStyle = 3 'Fixed Dialog
|
|
Caption = "BASS DX8 effects test"
|
|
ClientHeight = 2025
|
|
ClientLeft = 45
|
|
ClientTop = 405
|
|
ClientWidth = 4455
|
|
LinkTopic = "Form1"
|
|
MaxButton = 0 'False
|
|
MinButton = 0 'False
|
|
ScaleHeight = 2025
|
|
ScaleWidth = 4455
|
|
ShowInTaskbar = 0 'False
|
|
StartUpPosition = 2 'CenterScreen
|
|
Begin MSComctlLib.Slider sldEQR
|
|
Height = 1095
|
|
Index = 0
|
|
Left = 360
|
|
TabIndex = 5
|
|
Top = 600
|
|
Width = 675
|
|
_ExtentX = 1191
|
|
_ExtentY = 1931
|
|
_Version = 393216
|
|
Orientation = 1
|
|
Max = 20
|
|
TickStyle = 2
|
|
TickFrequency = 0
|
|
Value = 10
|
|
End
|
|
Begin MSComDlg.CommonDialog CMD
|
|
Left = 3720
|
|
Top = 2160
|
|
_ExtentX = 847
|
|
_ExtentY = 847
|
|
_Version = 393216
|
|
End
|
|
Begin VB.CommandButton cmdOpenFP
|
|
Caption = "click here to open a file..."
|
|
Height = 375
|
|
Left = 120
|
|
Style = 1 'Graphical
|
|
TabIndex = 0
|
|
Top = 120
|
|
Width = 4215
|
|
End
|
|
Begin MSComctlLib.Slider sldEQR
|
|
Height = 1095
|
|
Index = 1
|
|
Left = 1200
|
|
TabIndex = 6
|
|
Top = 600
|
|
Width = 675
|
|
_ExtentX = 1191
|
|
_ExtentY = 1931
|
|
_Version = 393216
|
|
Orientation = 1
|
|
Max = 20
|
|
TickStyle = 2
|
|
TickFrequency = 0
|
|
Value = 10
|
|
End
|
|
Begin MSComctlLib.Slider sldEQR
|
|
Height = 1095
|
|
Index = 2
|
|
Left = 2040
|
|
TabIndex = 7
|
|
Top = 600
|
|
Width = 675
|
|
_ExtentX = 1191
|
|
_ExtentY = 1931
|
|
_Version = 393216
|
|
Orientation = 1
|
|
Max = 20
|
|
SelStart = 10
|
|
TickStyle = 2
|
|
TickFrequency = 0
|
|
Value = 10
|
|
End
|
|
Begin MSComctlLib.Slider sldEQR
|
|
Height = 1095
|
|
Index = 3
|
|
Left = 3240
|
|
TabIndex = 8
|
|
Top = 600
|
|
Width = 675
|
|
_ExtentX = 1191
|
|
_ExtentY = 1931
|
|
_Version = 393216
|
|
Orientation = 1
|
|
Max = 20
|
|
SelStart = 20
|
|
TickStyle = 2
|
|
TickFrequency = 0
|
|
Value = 20
|
|
End
|
|
Begin VB.Label lblEQR
|
|
AutoSize = -1 'True
|
|
Caption = "reverb"
|
|
Height = 195
|
|
Index = 3
|
|
Left = 3360
|
|
TabIndex = 4
|
|
Top = 1770
|
|
Width = 450
|
|
End
|
|
Begin VB.Label lblEQR
|
|
AutoSize = -1 'True
|
|
Caption = "8 khz"
|
|
Height = 195
|
|
Index = 2
|
|
Left = 2160
|
|
TabIndex = 3
|
|
Top = 1770
|
|
Width = 480
|
|
End
|
|
Begin VB.Label lblEQR
|
|
AutoSize = -1 'True
|
|
Caption = "1 khz"
|
|
Height = 195
|
|
Index = 1
|
|
Left = 1320
|
|
TabIndex = 2
|
|
Top = 1770
|
|
Width = 390
|
|
End
|
|
Begin VB.Label lblEQR
|
|
AutoSize = -1 'True
|
|
Caption = "125 hz"
|
|
Height = 195
|
|
Index = 0
|
|
Left = 480
|
|
TabIndex = 1
|
|
Top = 1770
|
|
Width = 480
|
|
End
|
|
End
|
|
Attribute VB_Name = "frmFXtest"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = True
|
|
Attribute VB_Exposed = False
|
|
'///////////////////////////////////////////////////////////////////////////////
|
|
' frmFXtest.frm - Copyright (c) 2001-2007 (: JOBnik! :) [Arthur Aminov, ISRAEL]
|
|
' [http://www.jobnik.org]
|
|
' [ jobnik@jobnik.org ]
|
|
'
|
|
' BASS DX8 effects test
|
|
' Originally translated from - fxtest.c - example of Ian Luck
|
|
'///////////////////////////////////////////////////////////////////////////////
|
|
|
|
Option Explicit
|
|
|
|
Dim chan As Long ' channel handle
|
|
Dim fx(3) As Long ' 3 eq band + reverb
|
|
|
|
' display error messages
|
|
Public Sub Error_(ByVal es As String)
|
|
Call MsgBox(es & vbCrLf & vbCrLf & "error code: " & BASS_ErrorGetCode, vbExclamation, "Error")
|
|
End Sub
|
|
|
|
Private Sub Form_Initialize()
|
|
' change and set the current path, to prevent from VB not finding BASS.DLL
|
|
ChDrive App.Path
|
|
ChDir App.Path
|
|
|
|
' check the correct BASS was loaded
|
|
If (HiWord(BASS_GetVersion) <> BASSVERSION) Then
|
|
Call MsgBox("An incorrect version of BASS.DLL was loaded", vbCritical)
|
|
End
|
|
End If
|
|
|
|
' setup output - default device
|
|
If (BASS_Init(-1, 44100, 0, Me.hWnd, 0) = 0) Then
|
|
Call Error_("Can't initialize device")
|
|
End
|
|
End If
|
|
|
|
' check that DX8 features are available
|
|
Dim bi As BASS_INFO
|
|
Call BASS_GetInfo(bi)
|
|
If (bi.dsver < 8) Then
|
|
Call BASS_Free
|
|
Call Error_("DirectX 8 is not installed")
|
|
End
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub Form_Unload(Cancel As Integer)
|
|
Call BASS_Free
|
|
End Sub
|
|
|
|
Public Sub UpdateFX(ByVal b As Integer)
|
|
Dim v As Integer
|
|
|
|
v = sldEQR(b).value
|
|
|
|
If (b < 3) Then
|
|
Dim p As BASS_DX8_PARAMEQ
|
|
Call BASS_FXGetParameters(fx(b), p)
|
|
p.fGain = 10# - v
|
|
Call BASS_FXSetParameters(fx(b), p)
|
|
Else
|
|
Dim p1 As BASS_DX8_REVERB
|
|
Call BASS_FXGetParameters(fx(b), p1)
|
|
p1.fReverbMix = -0.012 * v * v * v
|
|
Call BASS_FXSetParameters(fx(b), p1)
|
|
End If
|
|
End Sub
|
|
|
|
|
|
Private Sub cmdOpenFP_Click()
|
|
On Local Error Resume Next ' incase Cancel is pressed
|
|
|
|
CMD.filename = ""
|
|
CMD.CancelError = True
|
|
CMD.flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly
|
|
CMD.Filter = "playable files|*.mo3;*.xm;*.mod;*.s3m;*.it;*.mtm;*.umx;*.mp3;*.mp2;*.mp1;*.ogg;*.wav;*.aif|All Files|*.*|"
|
|
CMD.ShowOpen
|
|
|
|
' if cancel was pressed, exit the procedure
|
|
If Err.Number = 32755 Then Exit Sub
|
|
|
|
' free both MOD and stream, it must be one of them! :)
|
|
Call BASS_MusicFree(chan)
|
|
Call BASS_StreamFree(chan)
|
|
|
|
#If 1 Then ' with FX flag
|
|
|
|
chan = BASS_StreamCreateFile(BASSFALSE, StrPtr(CMD.filename), 0, 0, BASS_SAMPLE_LOOP Or BASS_SAMPLE_FX)
|
|
If (chan = 0) Then chan = BASS_MusicLoad(BASSFALSE, StrPtr(CMD.filename), 0, 0, BASS_MUSIC_LOOP Or BASS_MUSIC_RAMP Or BASS_SAMPLE_FX, 1)
|
|
|
|
#Else ' without FX flag
|
|
|
|
chan = BASS_StreamCreateFile(BASSFALSE, StrPtr(CMD.filename), 0, 0, BASS_SAMPLE_LOOP)
|
|
If (chan = 0) Then chan = BASS_MusicLoad(BASSFALSE, StrPtr(CMD.filename), 0, 0, BASS_MUSIC_LOOP Or BASS_MUSIC_RAMP, 1)
|
|
|
|
#End If
|
|
|
|
If (chan = 0) Then ' whatever it is, it ain't playable
|
|
cmdOpenFP.Caption = "click here to open a file..."
|
|
Call Error_("Can't play the file")
|
|
Exit Sub
|
|
End If
|
|
|
|
cmdOpenFP.Caption = GetFileName(CMD.filename)
|
|
|
|
' setup the effects
|
|
Dim p As BASS_DX8_PARAMEQ
|
|
|
|
fx(0) = BASS_ChannelSetFX(chan, BASS_FX_DX8_PARAMEQ, 0) ' bass
|
|
fx(1) = BASS_ChannelSetFX(chan, BASS_FX_DX8_PARAMEQ, 0) ' mid
|
|
fx(2) = BASS_ChannelSetFX(chan, BASS_FX_DX8_PARAMEQ, 0) ' treble
|
|
fx(3) = BASS_ChannelSetFX(chan, BASS_FX_DX8_REVERB, 0) ' reverb
|
|
|
|
p.fGain = 0
|
|
p.fBandwidth = 18
|
|
|
|
p.fCenter = 125 ' bass [125hz]
|
|
Call BASS_FXSetParameters(fx(0), p)
|
|
|
|
p.fCenter = 1000 ' mid [1khz]
|
|
Call BASS_FXSetParameters(fx(1), p)
|
|
|
|
p.fCenter = 8000 ' treble [8khz]
|
|
Call BASS_FXSetParameters(fx(2), p)
|
|
|
|
' you can add more EQ bands with changing:
|
|
' p.fCenter = N [Hz] N>=80 and N<=16000
|
|
|
|
Call UpdateFX(0) ' bass
|
|
Call UpdateFX(1) ' mid
|
|
Call UpdateFX(2) ' treble
|
|
Call UpdateFX(3) ' reverb
|
|
|
|
Call BASS_ChannelPlay(chan, BASSFALSE)
|
|
End Sub
|
|
|
|
Private Sub sldEQR_Scroll(index As Integer)
|
|
sldEQR(index).Text = IIf(index < 3, 10 - sldEQR(index).value, 20 - sldEQR(index).value)
|
|
Call UpdateFX(index)
|
|
End Sub
|
|
|
|
'--------------------
|
|
' useful function :)
|
|
'--------------------
|
|
|
|
' get file name from file path
|
|
Public Function GetFileName(ByVal fp As String) As String
|
|
GetFileName = Mid(fp, InStrRev(fp, "\") + 1)
|
|
End Function
|