Много времени прошло после создания темы, а интереса к теме (по крайне мере у меня) не поубавилось.
Вот написанный мною пример на
Visual Basic 6.0 с использованием мультимедийной библиотеки
Bass (исп. версия
2.2, в настоящее время уже доступна
2.3).
Код:

Option Explicit
Dim A As Integer 'The number of song in list
Dim B As String 'The time of sound
Dim FName As String
Dim C As Integer
Const MaxTime = 65535 'Max of interval in timer
Dim chan As Long
Dim File As Long
'display error message
Sub Error_(ByVal es As String)
Call MsgBox(es & vbCrLf & vbCrLf & "error code: " & BASS_ErrorGetCode, vbExclamation, "Error")
End Sub
Private Sub Form_Load()
'Check if bass.dll is exists
If (Not FileExists(RPP(App.Path) & "bass.dll")) Then
Call MsgBox("BASS.DLL does not exists", vbCritical, "BASS.DLL")
End
End If
'Check that BASS 2.2 was loaded
If (BASS_GetVersion <> MakeLong(2, 2)) Then
Call MsgBox("BASS version 2.2 was not loaded", vbCritical, "Incorrect BASS.DLL")
End
End If
If (Not FileExists(RPP(App.Path) & "play.ini")) Then
Call MsgBox("play.ini does not exists.", vbCritical, "play.ini")
End
End If
File = FreeFile
Open "play.ini" For Input As File
Do Until EOF(File)
Line Input #File, B
List1.AddItem (B)
Loop
Close File
'initialize BASS
If (BASS_Init(-1, 44100, 0, Me.hWnd, 0) = 0) Then
Call Error_("Can't initialize device")
End
End If
' If (Not PlayFile) Then 'start a file playing by calling the PlayFile pushing
' BASS_Free
' End
'End If
Play.value = True 'start a file playing by pushing the play button
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call BASS_Free
End
End Sub
Private Sub Nx_Click()
If A = List1.ListCount - 1 Then
A = 0
Else
A = A + 1
End If
Play.value = True
End Sub
Private Sub Play_Click()
Timer1.Enabled = False
Text1.Text = List1.List(A)
If (Not PlayFile) Then 'start a file playing - call PlayFile function
BASS_Free
End
End If
End Sub
Private Sub Prev_Click()
If A = 0 Then
A = List1.ListCount - 1
Else
A = A - 1
End If
Play.value = True
End Sub
Function PlayFile() As Boolean
On Local Error Resume Next 'if Cancel pressed...
Call BASS_StreamFree(chan)
'Call BASS_MusicFree(chan)
chan = BASS_StreamCreateFile(BASSFALSE, List1.List(A), 0, 0, 0)
'If chan = 0 Then chan = BASS_MusicLoad(BASSFALSE, List1.List(A), 0, 0, 0, 0)
If chan = 0 Then
Call Error_("Selected file couldn't be played!")
PlayFile = False 'Can't load the file
Exit Function
End If
Call BASS_ChannelPlay(chan, BASSFALSE)
B = BASS_ChannelBytes2Seconds(chan, BASS_ChannelGetLength(chan))
B = Left(B, InStrRev(B, ",") - 1)
B = 1000 * B + 1000
Label1.Caption = B
CheckTime
Timer1.Enabled = True
FName = GetFileName(List1.List(A))
Text1.Text = Left(FName, InStrRev(FName, ".") - 1)
PlayFile = True
End Function
Private Sub Stp_Click()
Timer1.Enabled = False
Call BASS_ChannelStop(chan)
End Sub
Private Sub Timer1_Timer()
If C = 1 Then
CheckTime
Else: Timer1.Enabled = False 'C = 0
Nx.value = True
End If
Label1.Caption = B
End Sub
'--------------------------
' some useful functions :)
'--------------------------
'check if any file exists
Public Function FileExists(ByVal fp As String) As Boolean
FileExists = (Dir(fp) <> "")
End Function
'RPP = Return Proper Path
Function RPP(ByVal fp As String) As String
RPP = IIf(Mid(fp, Len(fp), 1) <> "\", fp & "\", fp)
End Function
'get file name from file path
Public Function GetFileName(ByVal fp As String) As String
GetFileName = Mid(fp, InStrRev(fp, "\") + 1)
End Function
'check Time
Public Sub CheckTime()
If B > MaxTime Then
B = B - MaxTime
C = 1 'Tell timer that i use big time
Timer1.Interval = MaxTime
Else:
Timer1.Interval = B
C = 0
End If
End Sub
Была следующая сложность в реализации:
как можно было узнать, когда одна композиция доиграет, что б запустить следующую по списку?
Так вот, обратите внимание на функции таймера
Код:

Dim A As Integer 'Количество песен в списке
Dim B As String 'Время песни
Dim C As Integer
Const MaxTime = 65535 'Max of interval in timer
...
B = BASS_ChannelBytes2Seconds(chan, BASS_ChannelGetLength(chan))
B = Left(B, InStrRev(B, ",") - 1)
B = 1000 * B + 1000 `получаем длину композиции в миллисекундах и округляем до секунды (+1000)
...
Private Sub Timer1_Timer()
If C = 1 Then
CheckTime
Else: Timer1.Enabled = False 'C = 0
Nx.value = True
End If
Label1.Caption = B
End Sub
...
Public Sub CheckTime()
If B > MaxTime Then
B = B - MaxTime
C = 1 'Tell timer that i use big time
Timer1.Interval = MaxTime
Else:
Timer1.Interval = B
C = 0
End If
End Sub
Время, которое максимально допустимо задать таймеру в Visual Basic 6.0, ограничено (65535 мс).
Естественно средне статическая песня играет значительно больше.
Так вот, я узнаю в сколько раз больше она играет, и сохраняю данное значение в переменной.
А таймер каждый интервал, будет проверят, не пора ли переключится на следующую песню.
А так как интервал (кроме последнего, а иногда и первого, если песня короче 65535 мс) достаточно велик, то и нагрузка на CPU будет достаточно либеральна.
P.S.
До этой реализации я использовал
mp3.ocx производства Vision Factory, который
можно скачать вместе с примером.
Во времена создания темы меня устраивал, но теперь увы требования по серьёзней.
Там естественно никакого таймера не надо было придумывать.
У объекта мр3.осх есть событие
SongPlayed() которое и отвечает за конец песни.
Достаточно написать
Код:

Private Sub mp3_SongPlayed()
NX.Value = True
End Sub
где NX. кнопка на следующую песню (см исх выше).