frmbasstest.frm

bass player system api c++

         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]   *
'*                                     [  [e-mail]  ]   *
'*                                                               *
'* 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_RAMP Or BASS_MUSIC_POSRESET Or BASS_SAMPLE_FLOAT Or BASS_MUSIC_FT2MOD, 0)

    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