Option Explicit
'per eventuali chiarimenti o consigli sul codice
'potete contattarmi tramite il forum di "www.pierotofy.it" (se siete iscritti)
'o tramite MSN Messenger all'indirizzo "bear_87@libero.it"
'memorizza il nome del file attualmente aperto dall periferica MCI
Dim CurrentFile As String
'questa è la funzione che mi permette ( in alternativa al Controllo MMcontrol) di utilizzare periferiche MCI.
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Sub cmdOpen_Click()
'chiudo la periferica MCI (potrebbero esserci in riproduzione altri files)
mciSendString "close " & CurrentFile, 0, 0, 0
'carico la finestra apri
CD.ShowOpen
'memorizzo il nome del file selezionato (mi servirà spesso) fra virgolette (chr(34)
CurrentFile = Chr(34) & CD.FileName & Chr(34)
'abilito i pulsanti play e stop
cmdPlay.Enabled = True
cmdStop.Enabled = False
End Sub
Private Sub cmdPlay_Click()
'azzero la scrollbar
hsLenght.Value = 0
'chiudo la periferica MCI
mciSendString "close " & CurrentFile, 0, 0, 0
'riapro l'MCI
mciSendString "open " & CurrentFile, 0, 0, 0
'inizio la riproduzione del file precedentemente memorizzato in CurrentFile
mciSendString "play " & CurrentFile, 0, 0, 0
'disabilito il pulsante stop
cmdStop.Enabled = True
'avvio la sub che imposta la durata totale della canzone nella proprietà Max della scroll
Durata
End Sub
Private Sub cmdStop_Click()
'chiudo la periferica MCI
mciSendString "close " & CurrentFile, 0, 0, 0
cmdStop.Enabled = False
End Sub
Private Sub Durata() 'calcola la durata in millisecondi del file (non funziona bene coi DivX
Dim TotalTime As String * 20 'crea una stringa di Buffer
mciSendString "status " & CurrentFile & " length", TotalTime, 20, 0& ' chiede all'MCI la durata del file corrente e la memorizza nel buffer
hsLenght.Max = Val(TotalTime) / 1000 'divide i millisecondi per avere i secondi
tmSong.Enabled = True 'attiva il timer della canzone
End Sub
Private Sub Form_Unload(Cancel As Integer)
'chiudo la periferica MCI se no (anche a programma scaricato) continua a riprodurre
mciSendString "close " & CurrentFile, 0, 0, 0
End Sub
'quando la scroll viene modificata dall'utente (tranne se usa le freccette ai lati)
Private Sub hsLenght_scroll()
Dim Position As Long
Position = hsLenght.Value
Position = Position * 1000 'moltiplico per 1000 perchè nella value ho memorizzato i millisecondi di canzone
mciSendString "play " & CurrentFile & " from " & Position, 0, 0, 0 'comincio a riprodurre dalla nuova posizione
End Sub
Private Sub tmSong_Timer() 'ogni millisecondo aggiorno la scroll
hsLenght.Value = hsLenght.Value + 1
If hsLenght.Value = hsLenght.Max Then tmSong.Enabled = False 'se la scroll è finita, allora anche la canzone è finita
mciSendString "close " & CurrentFile, 0, 0, 0 'chiudo la periferica MCI
cmdStop.Enabled = False 'disabilito il pulsante stop
lblTime = SecToMin(hsLenght.Value) & " / " & SecToMin(hsLenght.Max) 'aggiorno la label del tempo
End Sub
'questa funzione restituisce il tempo, a partire dai secondi, nel formato "0:00"
Private Function SecToMin(Sec As Integer) As String
Dim Secondi As Integer
Secondi = Sec Mod 60 'ricava il resto della divisione dei sec totali per 60
SecToMin = Str(Fix(Sec \ 60)) & ":" 'calcola i minuti (secondi diviso 60) togliendone i decimali (fix()) e aggiunge i ":"
If Secondi <= 9 Then
SecToMin = SecToMin & "0" & Secondi 'se i secondi <= a 9, gli scrive lo "0" davanti
Else
SecToMin = SecToMin & Secondi
End If
End Function