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 frmBassTest 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "BASS - simple playback test"
   ClientHeight    =   3135
   ClientLeft      =   10425
   ClientTop       =   3825
   ClientWidth     =   7830
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3135
   ScaleWidth      =   7830
   Begin MSComctlLib.Slider sldVol 
      Height          =   195
      Left            =   4560
      TabIndex        =   23
      Top             =   2760
      Width           =   1995
      _ExtentX        =   3519
      _ExtentY        =   344
      _Version        =   393216
      LargeChange     =   10
      Max             =   100
      SelStart        =   100
      TickFrequency   =   10
      Value           =   100
   End
   Begin VB.CommandButton cmdResumeAll 
      Caption         =   "Resume"
      Height          =   375
      Left            =   3120
      TabIndex        =   14
      Top             =   2580
      Width           =   1215
   End
   Begin VB.CommandButton cmdStopAll 
      Caption         =   "Stop Output"
      Height          =   375
      Left            =   1320
      TabIndex        =   13
      Top             =   2580
      Width           =   1695
   End
   Begin VB.Timer tmrBass 
      Enabled         =   0   'False
      Interval        =   250
      Left            =   600
      Top             =   2550
   End
   Begin VB.Frame frameStream 
      Caption         =   "Stream"
      Height          =   2415
      Left            =   120
      TabIndex        =   12
      Top             =   0
      Width           =   2415
      Begin MSComctlLib.Slider sldVolGlStr 
         Height          =   195
         Left            =   150
         TabIndex        =   25
         Top             =   2160
         Width           =   2115
         _ExtentX        =   3731
         _ExtentY        =   344
         _Version        =   393216
         LargeChange     =   1000
         SmallChange     =   100
         Max             =   10000
         SelStart        =   10000
         TickFrequency   =   1000
         Value           =   10000
      End
      Begin VB.CommandButton cmdStreamRemove 
         Caption         =   "Remove"
         Height          =   375
         Left            =   1200
         TabIndex        =   18
         Top             =   1560
         Width           =   1095
      End
      Begin VB.CommandButton cmdStreamRestart 
         Caption         =   "Restart"
         Height          =   375
         Left            =   1560
         TabIndex        =   20
         Top             =   1200
         Width           =   735
      End
      Begin VB.CommandButton cmdStreamAdd 
         Caption         =   "Add ..."
         Height          =   375
         Left            =   120
         TabIndex        =   19
         Top             =   1560
         Width           =   1095
      End
      Begin VB.CommandButton cmdStreamStop 
         Caption         =   "Stop"
         Height          =   375
         Left            =   840
         TabIndex        =   21
         Top             =   1200
         Width           =   735
      End
      Begin VB.ListBox lstStream 
         Height          =   840
         Left            =   120
         TabIndex        =   17
         Top             =   240
         Width           =   2175
      End
      Begin VB.CommandButton cmdStreamPlay 
         Caption         =   "Play"
         Height          =   375
         Left            =   120
         TabIndex        =   22
         Top             =   1200
         Width           =   735
      End
      Begin VB.Label Label2 
         Caption         =   "global volume"
         Height          =   195
         Left            =   180
         TabIndex        =   26
         Top             =   1965
         Width           =   1455
      End
   End
   Begin VB.Frame frameSamples 
      Caption         =   "Sample"
      Height          =   2415
      Left            =   5160
      TabIndex        =   7
      Top             =   0
      Width           =   2415
      Begin VB.CommandButton cmdSampleRemove 
         Caption         =   "Remove"
         Height          =   375
         Left            =   1200
         TabIndex        =   11
         Top             =   1560
         Width           =   1095
      End
      Begin VB.CommandButton cmdSampleAdd 
         Caption         =   "Add ..."
         Height          =   375
         Left            =   120
         TabIndex        =   10
         Top             =   1560
         Width           =   1095
      End
      Begin VB.ListBox lstSamples 
         Height          =   840
         Left            =   120
         TabIndex        =   9
         Top             =   240
         Width           =   2175
      End
      Begin VB.CommandButton cmdSamplePlay 
         Caption         =   "Play"
         Height          =   375
         Left            =   120
         TabIndex        =   8
         Top             =   1200
         Width           =   2175
      End
      Begin MSComctlLib.Slider sldVolglSam 
         Height          =   195
         Left            =   180
         TabIndex        =   29
         Top             =   2160
         Width           =   2115
         _ExtentX        =   3731
         _ExtentY        =   344
         _Version        =   393216
         LargeChange     =   1000
         SmallChange     =   100
         Max             =   10000
         SelStart        =   10000
         TickFrequency   =   1000
         Value           =   10000
      End
      Begin VB.Label Label4 
         Caption         =   "global volume"
         Height          =   195
         Left            =   240
         TabIndex        =   30
         Top             =   1965
         Width           =   1455
      End
   End
   Begin MSComDlg.CommonDialog DLG 
      Left            =   120
      Top             =   2520
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame frameMusic 
      Caption         =   "MOD Music"
      Height          =   2415
      Left            =   2640
      TabIndex        =   0
      Top             =   0
      Width           =   2415
      Begin VB.CommandButton cmdMusicRemove 
         Caption         =   "Remove"
         Height          =   375
         Left            =   1200
         TabIndex        =   6
         Top             =   1560
         Width           =   1095
      End
      Begin VB.CommandButton cmdMusicAdd 
         Caption         =   "Add ..."
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   1560
         Width           =   1095
      End
      Begin VB.CommandButton cmdMusicRestart 
         Caption         =   "Restart"
         Height          =   375
         Left            =   1560
         TabIndex        =   4
         Top             =   1200
         Width           =   735
      End
      Begin VB.CommandButton cmdMusicStop 
         Caption         =   "Stop"
         Height          =   375
         Left            =   840
         TabIndex        =   3
         Top             =   1200
         Width           =   735
      End
      Begin VB.CommandButton cmdMusicPlay 
         Caption         =   "Play"
         Height          =   375
         Left            =   120
         TabIndex        =   2
         Top             =   1200
         Width           =   735
      End
      Begin VB.ListBox lstMusic 
         Height          =   840
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   2175
      End
      Begin MSComctlLib.Slider sldVolGlMus 
         Height          =   195
         Left            =   150
         TabIndex        =   27
         Top             =   2160
         Width           =   2115
         _ExtentX        =   3731
         _ExtentY        =   344
         _Version        =   393216
         LargeChange     =   1000
         SmallChange     =   100
         Max             =   10000
         SelStart        =   10000
         TickFrequency   =   1000
         Value           =   10000
      End
      Begin VB.Label Label3 
         Caption         =   "global volume"
         Height          =   195
         Left            =   210
         TabIndex        =   28
         Top             =   1965
         Width           =   1455
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Volume"
      Height          =   195
      Left            =   5280
      TabIndex        =   24
      Top             =   2580
      Width           =   525
   End
   Begin VB.Label lblCPUP 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "CPU%"
      Height          =   195
      Left            =   6780
      TabIndex        =   16
      Top             =   2700
      Width           =   450
   End
   Begin VB.Label lblCPU 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "0.0"
      Height          =   195
      Left            =   7320
      TabIndex        =   15
      Top             =   2700
      Width           =   240
   End
End
Attribute VB_Name = "frmBassTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*****************************************************************
'* BASS Simple test (rev .1), copyright (c) 1999 Adam Hoult.     *
'*                                                               *
'* Updated: 2003-2007 by (: JOBnik! :) [Arthur Aminov, ISRAEL]   *
'*                                     [http://www.jobnik.org]   *
'*                                     [  jobnik@jobnik.org  ]   *
'*                                                               *
'* Originally translated from - basstest.c - example of Ian Luck *
'*****************************************************************

Option Explicit

' display error messages
Public Sub Error_(ByVal es As String)
    Call MsgBox(es & 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

    ' 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

    ' Initialize output - default device, 44100hz, stereo, 16 bits
    If BASS_Init(-1, 44100, 0, Me.hWnd, 0) = BASSFALSE Then
        Call Error_("Can't initialize digital sound system")
        End
    End If

    ' Start the timer
    tmrBass.Enabled = True

    DLG.filename = ""
    DLG.CancelError = True
    DLG.flags = cdlOFNExplorer Or cdlOFNFileMustExist Or cdlOFNHideReadOnly
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ' stop timer
    tmrBass.Enabled = False

    ' Close sound system and release everything
    Call BASS_Free
End Sub

' Pause output
Private Sub cmdStopAll_Click()
    Call BASS_Pause
End Sub

' Resume output
Private Sub cmdResumeAll_Click()
    Call BASS_Start
End Sub

Private Sub cmdStreamAdd_Click()
    On Local Error Resume Next    ' incase Cancel is pressed

    DLG.Filter = "Streamable Files (wav/aif/mp3/mp2/mp1/ogg)|*.wav;*.aif;*.mp3;*.mp2;*.mp1;*.ogg|All Files (*.*)|*.*|"
    DLG.ShowOpen

    ' if cancel was pressed, exit the procedure
    If Err.Number = 32755 Then Exit Sub

    Dim StreamHandle As Long
    
    StreamHandle = BASS_StreamCreateFile(BASSFALSE, StrPtr(DLG.filename), 0, 0, 0)

    If StreamHandle = 0 Then
        Call Error_("Can't open stream")
    Else
        lstStream.AddItem GetFileName(DLG.filename)
        lstStream.ItemData(lstStream.ListCount - 1) = StreamHandle
    End If
End Sub

' Free the selected stream resource
' Remove the selected list
Private Sub cmdStreamRemove_Click()
    If (lstStream.ListIndex >= 0) Then
        Call BASS_StreamFree(lstStream.ItemData(lstStream.ListIndex))
        lstStream.RemoveItem lstStream.ListIndex
    End If
End Sub

' Play the stream (continue from current position)
Private Sub cmdStreamPlay_Click()
    If (lstStream.ListIndex >= 0) Then _
            If (BASS_ChannelPlay(lstStream.ItemData(lstStream.ListIndex), BASSFALSE) = 0) Then _
            Call Error_("Can't play stream")
End Sub

' Stop the stream
Private Sub cmdStreamStop_Click()
    If (lstStream.ListIndex >= 0) Then _
            Call BASS_ChannelStop(lstStream.ItemData(lstStream.ListIndex))
End Sub

' Play the stream from the start
Private Sub cmdStreamRestart_Click()
    If (lstStream.ListIndex >= 0) Then _
            Call BASS_ChannelPlay(lstStream.ItemData(lstStream.ListIndex), BASSTRUE)
End Sub

Private Sub cmdMusicAdd_Click()
    On Local Error Resume Next

    DLG.Filter = "MOD Music Files (mo3/xm/mod/s3m/it/mtm/umx)|*.mo3;*.xm;*.mod;*.s3m;*.it;*.mtm;*.umx|All Files (*.*)|*.*|"
    DLG.ShowOpen

    ' if cancel was pressed, exit the procedure
    If Err.Number = 32755 Then Exit Sub

    Dim ModHandle As Long

    ' Load a music from "DLG.FileName" and make it use ramping
    ModHandle = BASS_MusicLoad(BASSFALSE, StrPtr(DLG.filename), 0, 0, BASS_MUSIC_RAMPS, 1)

    If ModHandle = 0 Then
        Call Error_("Can't Load Music")
    Else
        lstMusic.AddItem GetFileName(DLG.filename)
        lstMusic.ItemData(lstMusic.ListCount - 1) = ModHandle
    End If
End Sub

' Free the selected mod resource
' Remove the selected list
Private Sub cmdMusicRemove_Click()
    If (lstMusic.ListIndex >= 0) Then
        Call BASS_MusicFree(lstMusic.ItemData(lstMusic.ListIndex))
        lstMusic.RemoveItem lstMusic.ListIndex
    End If
End Sub

' Play the music (continue from current position)
Private Sub cmdMusicPlay_Click()
    If (lstMusic.ListIndex >= 0) Then _
            If (BASS_ChannelPlay(lstMusic.ItemData(lstMusic.ListIndex), BASSFALSE) = 0) Then _
            Call Error_("Can't play music")
End Sub

' Stop the music
Private Sub cmdMusicStop_Click()
    If (lstMusic.ListIndex >= 0) Then _
            Call BASS_ChannelStop(lstMusic.ItemData(lstMusic.ListIndex))
End Sub

' Play the music from the start
Private Sub cmdMusicRestart_Click()
    If (lstMusic.ListIndex >= 0) Then _
            Call BASS_ChannelPlay(lstMusic.ItemData(lstMusic.ListIndex), BASSTRUE)
End Sub

Private Sub cmdSampleAdd_Click()
    On Local Error Resume Next

    DLG.Filter = "Sample files (wav/aif)|*.wav;*.aif|All Files (*.*)|*.*|"
    DLG.ShowOpen

    ' if cancel was pressed, exit the procedure
    If Err.Number = 32755 Then Exit Sub

    Dim SampleHandle As Long

    ' Load a sample from "DLG.FileName" and give it a max of 3 simultaneous
    ' playings using playback position as override decider
    SampleHandle = BASS_SampleLoad(BASSFALSE, StrPtr(DLG.filename), 0, 0, 3, BASS_SAMPLE_OVER_POS)

    If SampleHandle = 0 Then
        Call Error_("Can't Load Sample")
    Else
        lstSamples.AddItem GetFileName(DLG.filename)
        lstSamples.ItemData(lstSamples.ListCount - 1) = SampleHandle
    End If
End Sub

' Play the sample at default rate, volume=50%, random pan position
Private Sub cmdSamplePlay_Click()
    If (lstSamples.ListIndex >= 0) Then
        Dim ch As Long
        ch = BASS_SampleGetChannel(lstSamples.ItemData(lstSamples.ListIndex), BASSFALSE)
        Call BASS_ChannelSetAttribute(ch, BASS_ATTRIB_VOL, 0.5)
        Call BASS_ChannelSetAttribute(ch, BASS_ATTRIB_PAN, ((201 * Rnd) - 100) / 100)
        If (BASS_ChannelPlay(ch, BASSFALSE) = 0) Then Error_ ("Can't play sample")
    End If
End Sub

' Free the selected sample resource
' Remove the selected list item
Private Sub cmdSampleRemove_Click()
    If (lstSamples.ListIndex >= 0) Then
        Call BASS_SampleFree(lstSamples.ItemData(lstSamples.ListIndex))
        lstSamples.RemoveItem lstSamples.ListIndex
    End If
End Sub

Private Sub sldVol_Scroll()
    Call BASS_SetVolume(sldVol.value / 100)
End Sub

Private Sub sldVolGlMus_Scroll()
    Call BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, sldVolGlMus.value)
End Sub

Private Sub sldVolglSam_Scroll()
    Call BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, sldVolglSam.value)
End Sub

Private Sub sldVolGlStr_Scroll()
    Call BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, sldVolGlStr.value)
End Sub

' Main timer, to update all info needed.
Private Sub tmrBass_Timer()
    ' update the CPU usage % display
    lblCPU.Caption = Format(BASS_GetCPU, "0.00")
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