Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
MCI Multimedia Control - frmMain.frm

frmMain.frm

Caricato da:
Scarica il programma completo

  1. Option Explicit
  2.  
  3. 'per eventuali chiarimenti o consigli sul codice
  4. 'potete contattarmi tramite il forum di "www.pierotofy.it" (se siete iscritti)
  5. 'o tramite MSN Messenger all'indirizzo "bear_87@libero.it"
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12. 'memorizza il nome del file attualmente aperto dall periferica MCI
  13. Dim CurrentFile As String
  14. 'questa è la funzione che mi permette ( in alternativa al Controllo MMcontrol) di utilizzare periferiche MCI.
  15. 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
  16.  
  17. Private Sub cmdOpen_Click()
  18. 'chiudo la periferica MCI (potrebbero esserci in riproduzione altri files)
  19. mciSendString "close " & CurrentFile, 0, 0, 0
  20. 'carico la finestra apri
  21. CD.ShowOpen
  22. 'memorizzo il nome del file selezionato (mi servirà spesso) fra virgolette (chr(34)
  23. CurrentFile = Chr(34) & CD.FileName & Chr(34)
  24. 'abilito i pulsanti play e stop
  25. cmdPlay.Enabled = True
  26. cmdStop.Enabled = False
  27. End Sub
  28.  
  29. Private Sub cmdPlay_Click()
  30. 'azzero la scrollbar
  31. hsLenght.Value = 0
  32. 'chiudo la periferica MCI
  33. mciSendString "close " & CurrentFile, 0, 0, 0
  34. 'riapro l'MCI
  35. mciSendString "open " & CurrentFile, 0, 0, 0
  36. 'inizio la riproduzione del file precedentemente memorizzato in CurrentFile
  37. mciSendString "play " & CurrentFile, 0, 0, 0
  38. 'disabilito il pulsante stop
  39. cmdStop.Enabled = True
  40. 'avvio la sub che imposta la durata totale della canzone nella proprietà Max della scroll
  41. Durata
  42. End Sub
  43.  
  44. Private Sub cmdStop_Click()
  45. 'chiudo la periferica MCI
  46. mciSendString "close " & CurrentFile, 0, 0, 0
  47. cmdStop.Enabled = False
  48. End Sub
  49.  
  50. Private Sub Durata()    'calcola la durata in millisecondi del file (non funziona bene coi DivX
  51. Dim TotalTime As String * 20    'crea una stringa di Buffer
  52. mciSendString "status " & CurrentFile & " length", TotalTime, 20, 0& ' chiede all'MCI la durata del file corrente e la memorizza nel buffer
  53. hsLenght.Max = Val(TotalTime) / 1000    'divide i millisecondi per avere i secondi
  54. tmSong.Enabled = True 'attiva il timer della canzone
  55. End Sub
  56.  
  57. Private Sub Form_Unload(Cancel As Integer)
  58. 'chiudo la periferica MCI se no (anche a programma scaricato) continua a riprodurre
  59. mciSendString "close " & CurrentFile, 0, 0, 0
  60. End Sub
  61.  
  62. 'quando la scroll viene modificata dall'utente (tranne se usa le freccette ai lati)
  63. Private Sub hsLenght_scroll()
  64. Dim Position As Long
  65. Position = hsLenght.Value
  66. Position = Position * 1000  'moltiplico per 1000 perchè nella value ho memorizzato i millisecondi di canzone
  67. mciSendString "play " & CurrentFile & " from " & Position, 0, 0, 0  'comincio a riprodurre dalla nuova posizione
  68. End Sub
  69.  
  70. Private Sub tmSong_Timer() 'ogni millisecondo aggiorno la scroll
  71. hsLenght.Value = hsLenght.Value + 1
  72. If hsLenght.Value = hsLenght.Max Then tmSong.Enabled = False 'se la scroll è finita, allora anche la canzone è finita
  73. mciSendString "close " & CurrentFile, 0, 0, 0   'chiudo la periferica MCI
  74. cmdStop.Enabled = False 'disabilito il pulsante stop
  75. lblTime = SecToMin(hsLenght.Value) & " / " & SecToMin(hsLenght.Max) 'aggiorno la label del tempo
  76. End Sub
  77.  
  78. 'questa funzione restituisce il tempo, a partire dai secondi, nel formato "0:00"
  79. Private Function SecToMin(Sec As Integer) As String
  80. Dim Secondi As Integer
  81. Secondi = Sec Mod 60    'ricava il resto della divisione dei sec totali per 60
  82. SecToMin = Str(Fix(Sec \ 60)) & ":"     'calcola i minuti (secondi diviso 60) togliendone i decimali (fix()) e aggiunge i ":"
  83. If Secondi <= 9 Then
  84.     SecToMin = SecToMin & "0" & Secondi     'se i secondi <= a 9, gli scrive lo "0" davanti
  85. Else
  86.     SecToMin = SecToMin & Secondi
  87. End If
  88. End Function