Hola Enter mira te puedo dar una ayuda rapida en base a lo que estoy haciendo, yo en realidad cree un modulo clase como para simplificar un poco las cosas, este modulo clase incluye otro modulo clase que es un timer asi que te paso los dos
ClsPlayAudio
Option Explicit
Private m_FilePath As String
Private m_ChannelLength As Double
Private chan As Long
Private m_Pause As Boolean
Private WithEvents cTimer As ClsTimer
Private WithEvents cTimerRewindAdvance As ClsTimer
Public Event Progress(Percent As Long, ChannelPosition As Double)
Public Event EndAudio()
Private m_ChannelPosition As Double
Private m_Rewind As Boolean
Private m_Advance As Boolean
Private m_Repeat As Boolean
Private m_OldVolumen As Single
Private m_Mute As Boolean
Private m_OutDevice As Long
Public Function InitDevice(ByVal hwnd As Long, Optional device As Long = -1) As Boolean
If (HiWord(BASS_GetVersion) <> BASSVERSION) Then Exit Function
InitDevice = BASS_Init(device, 44100, 0, hwnd, 0) <> BASSFALSE
End Function
Public Property Get Mute() As Boolean
Mute = m_Mute
End Property
Public Property Let Mute(value As Boolean)
If value Then
If m_Mute = False Then
Call BASS_ChannelGetAttribute(chan, BASS_ATTRIB_VOL, m_OldVolumen)
Call BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, 0)
m_Mute = True
End If
Else
If m_Mute Then
Call BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, m_OldVolumen)
m_Mute = False
End If
End If
End Property
Public Property Get Volumen() As Long
Call BASS_ChannelGetAttribute(chan, BASS_ATTRIB_VOL, m_OldVolumen)
Volumen = m_OldVolumen * 100
End Property
Public Property Let Volumen(value As Long)
m_Mute = False
m_OldVolumen = value / 100
Call BASS_ChannelSetAttribute(chan, BASS_ATTRIB_VOL, m_OldVolumen)
End Property
Public Function LoadFile(sPath As String) As Boolean
On Error GoTo ErrHandler
If chan <> 0 Then Call BASS_StreamFree(chan)
m_FilePath = vbNullString
If Len(Dir(sPath, vbArchive)) = 0 Then Exit Function
chan = BASS_StreamCreateFile(BASSFALSE, StrPtr(sPath), 0, 0, 0)
If (chan = 0) Then GoTo ErrHandler
m_FilePath = sPath
m_Pause = True
m_ChannelLength = BASS_ChannelBytes2Seconds(chan, BASS_ChannelGetLength(chan, BASS_POS_BYTE))
If m_OldVolumen > 0 Then Me.Volumen = m_OldVolumen * 100
LoadFile = m_ChannelLength > 0
Exit Function
ErrHandler:
m_ChannelLength = 0
Debug.Print "ClsPlayAudio Error LoadFile", sPath
End Function
Public Sub ReleaseFile()
On Error Resume Next
StopAudio
If chan Then Call BASS_StreamFree(chan)
m_ChannelLength = 0
m_FilePath = vbNullString
m_Mute = False
End Sub
Public Function Play() As Boolean
If m_ChannelLength = 0 Then Exit Function
m_Pause = False
Play = BASS_ChannelPlay(chan, BASSFALSE)
If Play Then
cTimer.CreateTimer 100
End If
End Function
Public Property Let device(ByVal OutDev As Long)
Call BASS_ChannelSetDevice(chan, OutDev)
m_OutDevice = OutDev
End Property
Public Property Get device() As Long
device = m_OutDevice
End Property
Public Property Get AudioLength() As Double
AudioLength = m_ChannelLength
End Property
Public Function StopAudio() As Boolean
Me.Advance = False
cTimer.DestroyTimer
Call BASS_ChannelStop(chan)
m_Pause = True
BASS_ChannelSetPosition chan, BASS_ChannelSeconds2Bytes(chan, 0), BASS_POS_BYTE
RaiseEvent Progress(0, 0)
End Function
Public Property Let Repeat(value As Boolean)
m_Repeat = value
End Property
Public Property Get Repeat() As Boolean
Repeat = m_Repeat
End Property
Public Property Let Pause(value As Boolean)
If m_ChannelLength = 0 Then Exit Property
If value Then
Call BASS_ChannelPause(chan)
cTimer.DestroyTimer
Else
Call BASS_ChannelPlay(chan, BASSFALSE)
cTimer.CreateTimer 100
End If
m_Pause = value
End Property
Public Property Get Pause() As Boolean
Pause = m_Pause
End Property
Public Property Get isAudioPlay() As Boolean
isAudioPlay = BASS_ChannelIsActive(chan)
End Property
Public Property Get handle() As Long
handle = chan
End Property
Public Property Get ChannelPosition() As Double
ChannelPosition = BASS_ChannelBytes2Seconds(chan, BASS_ChannelGetPosition(chan, BASS_POS_BYTE))
End Property
Public Property Let ChannelPosition(value As Double)
BASS_ChannelSetPosition chan, BASS_ChannelSeconds2Bytes(chan, value), BASS_POS_BYTE
End Property
Public Property Let ChannelPositionPercent(value As Long)
Dim lPercent As Long
lPercent = m_ChannelLength * value / 100
BASS_ChannelSetPosition chan, BASS_ChannelSeconds2Bytes(chan, lPercent), BASS_POS_BYTE
End Property
Public Property Get ChannelPositionPercent() As Long
m_ChannelPosition = BASS_ChannelBytes2Seconds(chan, BASS_ChannelGetPosition(chan, BASS_POS_BYTE))
ChannelPositionPercent = m_ChannelPosition * 100 / m_ChannelLength
End Property
Public Property Let Advance(value As Boolean)
m_Rewind = False
m_Advance = value
If value Then
cTimerRewindAdvance.CreateTimer 500
Else
cTimerRewindAdvance.DestroyTimer
End If
End Property
Public Property Get Advance() As Boolean
Advance = m_Advance
End Property
Public Property Let Rewind(value As Boolean)
m_Advance = False
m_Rewind = value
If value Then
cTimerRewindAdvance.CreateTimer 500
Else
cTimerRewindAdvance.DestroyTimer
End If
End Property
Public Property Get Rewind() As Boolean
Rewind = m_Rewind
End Property
Private Sub Class_Initialize()
m_OutDevice = -1 'Defaul
Set cTimer = New ClsTimer
Set cTimerRewindAdvance = New ClsTimer
End Sub
Private Sub cTimer_Timer(ByVal ThisTime As Long)
Dim lPercent As Long
If m_ChannelLength = 0 Then Exit Sub
m_ChannelPosition = BASS_ChannelBytes2Seconds(chan, BASS_ChannelGetPosition(chan, BASS_POS_BYTE))
lPercent = m_ChannelPosition * 100 / m_ChannelLength
RaiseEvent Progress(lPercent, m_ChannelPosition)
If BASS_ChannelIsActive(chan) = 0 Then
Me.StopAudio
If m_Repeat Then
Me.Play
Else
RaiseEvent EndAudio
End If
End If
End Sub
Public Sub Forzar()
Call BASS_ChannelStop(chan)
Call BASS_StreamFree(chan)
End Sub
Private Sub Class_Terminate()
Set cTimer = Nothing
Set cTimerRewindAdvance = Nothing
If chan Then Call BASS_StreamFree(chan)
'Call BASS_Free 'esta deshabilitado porque si se usa mas de una clase corta el audio llamar BASS_Free al final de la aplicacion
End Sub
Private Sub cTimerRewindAdvance_Timer(ByVal ThisTime As Long)
If m_Advance Then
If Me.ChannelPosition >= m_ChannelLength Then
Me.Advance = False
Else
Me.ChannelPosition = Me.ChannelPosition + 3
End If
Call cTimer_Timer(0)
End If
If m_Rewind Then
If Me.ChannelPosition <= 0 Then
Me.Rewind = False
Else
Me.ChannelPosition = Me.ChannelPosition - 3
End If
Call cTimer_Timer(0)
End If
End Sub
ClsTimer
Option Explicit
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' Porcedur-Nummer der WndProc in der Klasse, wird zur Adressermittlung verwendet
Private Const ProcNr_WndProc = 0
Private Const GWL_WNDPROC As Long = -4
' Private Const asmMain As String = "558BEC83C4FC8D45FC50FF7514FF7510FF750CFF75086888888888B888888888FFD08B45FCC9C21000"
Private Const asmMain As String = "558BEC50FF7514FF7510FF750CFF75086855555555B866666666FFD0C9C21000" ' |<pCls>| |<Proc>|"
' |<pCls>| |<Proc>|
Private ASM() As Byte ' Array für AsseblerCode
Private ProcPtr As Long
Private TimerID As Long ' the TimerID which is returnd from the Windows SetTimer Function
' ===========================================================================
' NAME: Timer
' DESC: Timer-Event
' PARA(ThisTime): Time in milli seconds since Windows start
' ===========================================================================
Event Timer(ByVal ThisTime As Long)
' ProcedureNr = 0
Public Sub TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
' ===========================================================================
' NAME: TimerProc
' DESC: CallBack-Function for the Timer
' DESC: Do not call this function by yourself, it's called from the
' DESC: Windows Timer Function
' DESC: This function must be public because we need the Procedure-Adress
' DESC: for the Windows Call Back.
' ===========================================================================
RaiseEvent Timer(dwTime)
End Sub
Public Function CreateTimer(ByVal Milliseconds As Long) As Long
' ===========================================================================
' NAME: CreateTimer
' DESC: Creates a Timer and returns a non zero Value which is the
' DESC: Windows-Timer-ID when succeeding
' DESC: It is not possible to change the interval, first kill the
' DESC: Timer and create it new
' ===========================================================================
Dim ret As Long
If TimerID = 0 Then ' If the Timer does not exist
' create the Timer
ret = SetTimer(0&, 0&, Milliseconds, ProcPtr)
If ret <> 0 Then
TimerID = ret
CreateTimer = ret
End If
Else ' if the Timer already exists
' pass back the current TimerID
CreateTimer = TimerID
End If
End Function
Public Function DestroyTimer() As Long
' ===========================================================================
' NAME: DestroyTimer
' DESC: Destroy the current Timer an pass back a non zero value when succeeding
' ===========================================================================
Dim ret As Long
If TimerID <> 0 Then ' If the Timer exists
ret = KillTimer(0&, TimerID)
If ret <> 0 Then
TimerID = 0
End If
End If
End Function
Private Function GetProcPtr(ClassPtr As Long, ProcNumber As Long) As Long
' ===========================================================================
' NAME: GetProcPtr
' DESC: eErmittelt anhand des ObjektPointers der Instanz und der laufenden
' DESC: Procedure-Nummer der Klasse, die StartAdresse der Procedure/Function
' PARA(ClassPtr As Long): ObjektPointer der Instanz der Klasse
' PARA(ProcNumber As Long): Laufende Nr. der Procedure/Funktion (0-basierend)
' RETURN: StartAdresse der Procedure/Function
' ===========================================================================
Dim ptrTemp As Long
Dim ptrProc As Long
' ptrTemp = StartAdresse der Objektdefinitions-Daten = [ClassPtr]
CopyMemory ptrTemp, ByVal ClassPtr, 4
' Die StartAdresse der Function in ptrProc kopieren
' &H1C ist die OffsetAdresse für die Procedureliste
CopyMemory ptrProc, ByVal ptrTemp + &H1C + (4 * ProcNumber), 4
GetProcPtr = ptrProc
End Function
Private Function CreateASMContainer(ClassPtr As Long, ProcNumber As Long) As Long
' ===========================================================================
' NAME: CreateASMContainer
' DESC: ByteArray mit AssemblerCode erstellen und ClassPtr und ProcPtr
' DESC: in den AssemblerCode eintragen
' PARA(ClassPtr): ObjektPointer der Instanz von clsSubclass
' PARA(ProcNumber): ProcedureNummer der WndProc in clsSubclass
' Return: Startadresse der AssemblerRoutine (=Adresse 1 Byte im Array)
' ===========================================================================
Dim ProcPtr As Long
ProcPtr = GetProcPtr(ClassPtr, ProcNumber)
Dim L As Long
Dim W As Long
L = Len(asmMain) \ 2 - 1
ReDim ASM(0 To L)
For W = 0 To L
ASM(W) = "&H" & Mid$(asmMain, W * 2 + 1, 2)
Next
CopyMemory ASM(17), ClassPtr, 4 ' Objektadresse der Instanz in AssemblerCode eintragen
CopyMemory ASM(22), ProcPtr, 4 ' Adresse der WndProc in AssemblerCode eintragen
' StartAdresse der AssemblerRoutine als Funktionswert zurückgeben
CreateASMContainer = VarPtr(ASM(0)) ' StartAdresse der AssemblerRoutine als Funktionswert
End Function
Private Sub Class_Initialize()
ProcPtr = CreateASMContainer(ObjPtr(Me), ProcNr_WndProc)
End Sub
Private Sub Class_Terminate()
DestroyTimer
End Sub
y en un Formulario
Option Explicit
Private WithEvents cPlayAudio1 As ClsPlayAudio
Private Sub cPlayAudio1_Progress(Percent As Long, ChannelPosition As Double)
Dim Level As Long
Dim BumetroL As Long
Dim BumetroR As Long
Me.Caption = Percent & " %"
Level = BASS_ChannelGetLevel(cPlayAudio1.handle)
If Level > -1 Then
BumetroL = LoWord(Level) / 350
BumetroR = HiWord(Level) / 350
'ucBumetro1.Value = LoWord(Level) / 350
'ucBumetro2.Value = HiWord(Level) / 350
Me.Cls
Me.Line (0, 150)-(Me.ScaleWidth * BumetroL / 100, 0), vbGreen, BF
Me.Line (0, 350)-(Me.ScaleWidth * BumetroR / 100, 200), vbGreen, BF
End If
End Sub
Private Sub Form_Load()
Set cPlayAudio1 = New ClsPlayAudio
cPlayAudio1.InitDevice Me.hwnd, 1
cPlayAudio1.device = 1 'aca elegis la placa
cPlayAudio1.LoadFile "D:\Mis documentos\Mi música\Bebel Gilberto\06 - Azul.mp3"
cPlayAudio1.Play
End Sub
Private Sub Form_Unload(Cancel As Integer)
cPlayAudio1.StopAudio
Set cPlayAudio1 = Nothing
Call BASS_Free
End Sub
bueno y obviamente tenes que incluir el modulo MdlBass.bas
una ves que pusiste a andar el ejemplo empeza a investigar la clase ClsPlayAudio y vas a ver que tiene unas cuantas funciones para reproducir audio.(pausa, stop play, adelantar revovinar, volumen .etc)
Aclaro la clase esta echa a mi necesidad puede que no ajuste a la necesidad de todos.
