Conoscere la durata di un file Midi con le sole risorse di Gambas

Da Gambas-it.org - Wikipedia.

Per conoscere la durata di un file Midi di tipo 1 mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente, nel quale si otterranno anche le durate delle singole tracce MTrk presenti nel file ed alcune generiche informazioni:

Public Sub Main()
 
 Dim fl As File
 Dim fileMidi, s As String
 Dim hbpm, tot, mx, tratto1 As Integer
 Dim td, bpm, c As Short
 Dim tr, b, n, av As Byte
 Dim cmd, tipocmd, ultimo As Byte
 Dim f, durata As Float
  
  fileMidi = "' /percorso/del/file.mid"
  Print "File Midi:         "; fileMidi
  
  fl = Open fileMidi For Read
  If IsNull(fl) Then Error.Raise("Impossibile aprire il file !")
  
  Read #fl, s, 4
  If s <> "MThd" Then Error.Raise("Il file non è uno standard Midi !")
  Print "Dimensione:    "; Lof(fl); " byte"
  Seek #fl, 9
  Read #fl, b
  If b <> 1 Then Error.Raise("Il tipo " & b & " non è supportato dal programma !")
  Seek #fl, 11
  Read #fl, tr
  Print "Numero tracce:   "; Format(tr, "###")
  Read #fl, td
  td = Rol(td, 8)
  Print "Risoluzione TΔ:  "; Format(td, "###")
  Avanza(fl, 8)
  
  bpm = 120
  
  Repeat
    tot = 0
    Do
      tot += legge_var(fl)
      Read #fl, b
      If b And 128 Then   Status running"
        cmd = b
        ultimo = cmd
        av = 2
      Else
        cmd = ultimo
        av = 1
      Endif
      tipocmd = Shr(cmd, 4)
      Select Case tipocmd
        Case 8 To 11
          Avanza(fl, av)
        Case 12 To 13 
          Avanza(fl, 1)
        Case 14
          Avanza(fl, av)
        Case &F0          Evento SysSex"
        Repeat
          b = Read #fl As Byte
        Until b = &7F
          Avanza(fl, 1)
        Case 15
          Read #fl, b
          Select Case b
            Case &51
              durata += DurataParziale(bpm, td, tot) 
              tratto1 += tot
              tot = 0
              Avanza(fl, 1)
              hbpm = 0
              For c = 2 To 0 Step -1
                Read #fl, n
                hbpm += Shl(CInt(n), 8 * c)
              Next
              bpm = 60000000 / hbpm
            Case &2F
              mx = Max(mx, tot)
              Exit
            Case Else
              Read #fl, b
              Avanza(fl, b)
          End Select
      End Select
    Loop
    Dec tr
    If tr > 0 Then Avanza(fl, 9)
  Until tr = 0
  
  fl.Close
  
  f = DurataParziale(bpm, td, Max(mx, tratto1) - tratto1)
  
  Print "\n\e[31m"; CStr(Date(0, 0, 0, 0, 0, 0, (f + durata) * 1000)); "\e[0m"
  
End
 
 
Private Procedure Avanza(mf As File, av As Byte)
 
 Dim b, n As Byte
  
  For b = 1 To av
    Read #mf, n
  Next
 
End
 
Private Function legge_var(mf As File) As Integer   ' Legge un numero a lunghezza-variabile (tempo Delta)

Dim vl As Integer
Dim c As Byte
 
 Repeat
   Read #mf, c
   vl = Shl(vl, 7) Or (c And 127)
 Until Not (c And 128)
 
 Return vl
 
End
 
Private Function DurataParziale(bpm As Integer, del As Short, par As Integer) As Float
 
  Return CFloat((((60000000 / bpm) / del) * par) / 1000000)
 
End