[Admiral]

Много времени прошло после создания темы, а интереса к теме (по крайне мере у меня) не поубавилось.

Вот написанный мною пример на 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. кнопка на следующую песню (см исх выше).