Differenze tra le versioni di "Conoscere la durata di un file Midi con le sole risorse di Gambas"

Da Gambas-it.org - Wikipedia.
(Creata pagina con "Per conoscere la durata di un file Midi mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente: <FONT Color=red size=4><B>Pagina in costruzio...")
 
Riga 1: Riga 1:
 
Per conoscere la durata di un file Midi mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente:
 
Per conoscere la durata di un file Midi mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente:
−
 
+
Private fl As File
−
 
+
Private file_offset As Integer
−
<FONT Color=red size=4><B>Pagina in costruzione !</b></font>
+
Private bpm$ As String
 +
 +
 +
'''Public''' Sub Main()
 +
 
 +
  Dim fileMidi, s As String
 +
  Dim durata_Midi 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 !")
 +
   
 +
  durata_Midi = legge_smf()
 +
   
 +
  Print "\n\n  DURATA del FILE MIDI:  "; Date(0, 0, 0, 0, 0, 0, durata_Midi * 1000)
 +
   
 +
'''End'''
 +
 +
 +
'''Private''' Function legge_smf() As Float  <FONT Color=gray>' ''Legge l'intero file Midi''</font>
 +
 
 +
  Dim lung_MThd, tipo, risoluzione_TD, lenI As Integer
 +
  Dim num_traccia As Short
 +
  Dim err, traccia As Byte
 +
  Dim s As String
 +
  Dim dur, superior As Float
 +
 +
<FONT Color=gray>' ''La corrente posizione all'interno del file è immediatamento dopo "Mthd":''</font>
 +
  lung_MThd = legge_dal_file(4)
 +
  If lung_MThd <> 6 Then Error.Raise("Formato di file non valido !")
 +
 
 +
  tipo = legge_dal_file(2)
 +
  If (tipo <> 0) And (tipo <> 1) Then Error.Raise("Il tipo " & tipo & " non è supportato !")
 +
 
 +
  num_traccia = legge_dal_file(2)
 +
  If (num_traccia < 1) Or (num_traccia > 1000) Then Error.Raise(num_traccia & ": è un numero di tracce non valido !")
 +
  Print "\n\n=== DURATA delle";; num_traccia;; "TRACCE ===\n"
 +
 
 +
  risoluzione_TD = legge_dal_file(2)
 +
  If risoluzione_TD < 0 Then Error.Raise("Formato di file non valido !")
 +
 
 +
<FONT Color=gray>' ''Legge le tracce MTrk del file Midi:''</font>
 +
  For traccia = 1 To num_traccia '- 1
 +
<FONT Color=gray>' ''Cerca il blocco "Mtrk" della traccia corrente:''</font>
 +
    For err = 0 To 1
 +
      Read #fl, s, 4
 +
      lenI = legge_dal_file(4)
 +
      If Eof(fl) Then Error.Raise("Inattesa fine del file !")
 +
      If (lenI < 0) Or (lenI >= 268435456) Then Error.Raise(CStr(lenI) & ": lunghezza del blocco traccia non valido !")
 +
      If s = "MTrk" Then Exit
 +
    Next
 +
   
 +
    file_offset = Seek(fl)
 +
     
 +
    dur = legge_traccia(CStr(traccia), file_offset + lenI, risoluzione_TD)
 +
       
 +
    superior = Max(dur, superior)
 +
     
 +
  Next
 +
   
 +
  Return superior
 +
 
 +
'''End'''
 +
 +
 +
'''Private''' Function legge_traccia(nmt As String, fine_traccia As Integer, rTD As Integer) As Float
 +
 
 +
  Dim tick, delta_ticks, lenI, totale_tick_traccia As Integer
 +
  Dim c, ultimo_cmd, cmd, tipo_cmd As Byte
 +
  Dim f As Float
 +
  Dim tempus, t1 As String
 +
 +
<FONT Color=gray>' ''L'attuale posizione del puntatore nel file Midi è dopo i byte di identificazione e di lunghezza della traccia:''</font>
 +
  While file_offset < fine_traccia
 +
    delta_ticks = legge_var()
 +
   
 +
    If delta_ticks < 0 Then Break
 +
   
 +
    tick += delta_ticks
 +
   
 +
    Read #fl, c
 +
    file_offset += 1
 +
   
 +
    If c < 0 Then Break
 +
   
 +
    If c And 128 Then
 +
      cmd = c
 +
      If cmd < 240 Then ultimo_cmd = cmd
 +
 +
    Else
 +
<FONT Color=gray>' ''Status Running:''</font>
 +
      Read #fl, c
 +
      Dec file_offset
 +
      cmd = ultimo_cmd
 +
      If Not cmd Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 +
   
 +
    Endif
 +
 +
    tipo_cmd = cmd \ CInt(2 ^ 4)
 +
 +
    Select Case tipo_cmd
 +
      Case 8 To 11
 +
        legge_byte()
 +
        legge_byte()
 +
      Case 14
 +
        legge_byte()
 +
        legge_byte()
 +
      Case 12 To 13
 +
        legge_byte()
 +
      Case 15
 +
        Select Case cmd
 +
          Case 240, 247
 +
            lenI = legge_var()
 +
            If lenI < 0 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 +
            If cmd = 240 Then
 +
              Inc lenI
 +
              c = 1
 +
            Else
 +
              c = 1
 +
            Endif
 +
              For c = 0 To lenI - 1
 +
                legge_byte()
 +
              Next
 +
              Break
 +
 
 +
          Case 255          <FONT Color=gray>' ''Meta-evento''</font>
 +
            c = legge_byte()
 +
            lenI = legge_var()
 +
            If lenI < 0 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 +
            Select Case c
 +
              Case 33
 +
                If lenI < 1 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 +
                legge_byte()
 +
                salto(lenI - 1)
 +
              Case 47                    <FONT Color=gray>' ''Fine traccia''</font>
 +
                totale_tick_traccia = tick
 +
                If nmt = "1" Then t1 = "  (del Tempo)"
 +
                f = (((60000000 / Fix(60000000 / Val("&" & bpm$))) / rTD) * totale_tick_traccia) / 1000000
 +
                If f > 0 Then tempus = Str(Date(0, 0, 0, 0, 0, 0, f * 1000))
 +
                If IsNull(tempus) Then tempus = "00:00:00"
 +
                Print "Traccia";; nmt; ": "; "  "; tempus; t1
 +
                Print "------------------------------------"
 +
                 
 +
                Return f
 +
 
 +
              Case 81
 +
                If lenI < 3 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 +
                bpm$ = Hex(legge_byte(), 2)
 +
                bpm$ &= Hex(legge_byte(), 2)
 +
                bpm$ &= Hex(legge_byte(), 2)
 +
                salto(lenI - 3)
 +
              Case Else        ' Ignora gli altri Meta-eventi
 +
                salto(lenI)
 +
 +
            End Select
 +
          Case Else    ' Comando Fx non valido
 +
            Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 +
        End Select
 +
      Case Else
 +
        Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
 +
    End Select
 +
   
 +
  Wend
 +
 
 +
'''End'''
 +
 +
 +
'''Private''' Function legge_var() As Integer  <FONT Color=gray>' ''Legge un numero a lunghezza-variabile (tempo Delta)''</font>
 +
 
 +
  Dim valore As Integer
 +
  Dim c As Byte
 +
 
 +
  Read #fl, c
 +
  valore = c And 127
 +
  If c And 128 Then
 +
    Read #fl, c
 +
    valore = (valore * CInt(2 ^ 7)) Or (c And 127)
 +
    If c And 128 Then
 +
      Read #fl, c
 +
      valore = (valore * CInt(2 ^ 7)) Or (c And 127)
 +
      If c And 128 Then
 +
        Read #fl, c
 +
        valore = (valore * CInt(2 ^ 7)) Or c
 +
        If c And 128 Then Return -1
 +
      Endif
 +
    Endif
 +
  Endif
 +
 
 +
  Return valore
 +
 
 +
'''End'''
 +
 +
 +
'''Private''' Function legge_byte() As Byte
 +
 
 +
  Dim b As Byte
 +
 
 +
  Inc file_offset
 +
 
 +
  Read #fl, b
 +
   
 +
  Return b
 +
 
 +
'''End'''
 +
 +
 +
'''Private''' Procedure salto(b As Byte)
 +
 
 +
  While b > 0
 +
    legge_byte()
 +
    Dec b
 +
  Wend
 +
  file_offset += b
 +
   
 +
'''End'''
 +
 +
 +
'''Private''' Function legge_dal_file(by As Short) As Integer
 +
 
 +
  Dim valore As Integer
 +
  Dim b As Byte
 +
 
 +
  Do
 +
    Read #fl, b
 +
    If b = -1 Then Return -1
 +
    valore = (valore * CInt(2 ^ 8)) Or b
 +
    Dec by
 +
  Loop Until by = 0
 +
   
 +
  Return valore
 +
 
 +
'''End'''

Versione delle 07:27, 23 ago 2015

Per conoscere la durata di un file Midi mediante le sole risorse di Gambas, è possibile utilizzare un codice come il seguente: 

Private fl As File
Private file_offset As Integer
Private bpm$ As String


Public Sub Main()
 
 Dim fileMidi, s As String
 Dim durata_Midi 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 !")
   
  durata_Midi = legge_smf()
   
  Print "\n\n  DURATA del FILE MIDI:  "; Date(0, 0, 0, 0, 0, 0, durata_Midi * 1000)
   
End


Private Function legge_smf() As Float   ' Legge l'intero file Midi
 
 Dim lung_MThd, tipo, risoluzione_TD, lenI As Integer
 Dim num_traccia As Short
 Dim err, traccia As Byte
 Dim s As String
 Dim dur, superior As Float

' La corrente posizione all'interno del file è immediatamento dopo "Mthd":
  lung_MThd = legge_dal_file(4)
  If lung_MThd <> 6 Then Error.Raise("Formato di file non valido !")
  
  tipo = legge_dal_file(2)
  If (tipo <> 0) And (tipo <> 1) Then Error.Raise("Il tipo " & tipo & " non è supportato !")
  
  num_traccia = legge_dal_file(2)
  If (num_traccia < 1) Or (num_traccia > 1000) Then Error.Raise(num_traccia & ": è un numero di tracce non valido !")
  Print "\n\n=== DURATA delle";; num_traccia;; "TRACCE ===\n"
  
  risoluzione_TD = legge_dal_file(2)
  If risoluzione_TD < 0 Then Error.Raise("Formato di file non valido !")
  
' Legge le tracce MTrk del file Midi:
  For traccia = 1 To num_traccia '- 1
' Cerca il blocco "Mtrk" della traccia corrente:
    For err = 0 To 1
      Read #fl, s, 4
      lenI = legge_dal_file(4)
      If Eof(fl) Then Error.Raise("Inattesa fine del file !")
      If (lenI < 0) Or (lenI >= 268435456) Then Error.Raise(CStr(lenI) & ": lunghezza del blocco traccia non valido !")
      If s = "MTrk" Then Exit
    Next
    
    file_offset = Seek(fl)
     
    dur = legge_traccia(CStr(traccia), file_offset + lenI, risoluzione_TD)
       
    superior = Max(dur, superior)
     
  Next
   
  Return superior
  
End


Private Function legge_traccia(nmt As String, fine_traccia As Integer, rTD As Integer) As Float
 
 Dim tick, delta_ticks, lenI, totale_tick_traccia As Integer
 Dim c, ultimo_cmd, cmd, tipo_cmd As Byte
 Dim f As Float
 Dim tempus, t1 As String

' L'attuale posizione del puntatore nel file Midi è dopo i byte di identificazione e di lunghezza della traccia:
  While file_offset < fine_traccia
    delta_ticks = legge_var()
    
    If delta_ticks < 0 Then Break
    
    tick += delta_ticks
    
    Read #fl, c
    file_offset += 1
    
    If c < 0 Then Break
    
    If c And 128 Then
      cmd = c
      If cmd < 240 Then ultimo_cmd = cmd

    Else
' Status Running:
      Read #fl, c
      Dec file_offset
      cmd = ultimo_cmd
      If Not cmd Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
    
    Endif

    tipo_cmd = cmd \ CInt(2 ^ 4)

    Select Case tipo_cmd
      Case 8 To 11
        legge_byte()
        legge_byte()
      Case 14
        legge_byte()
        legge_byte()
      Case 12 To 13
        legge_byte()
      Case 15
        Select Case cmd
          Case 240, 247
            lenI = legge_var()
            If lenI < 0 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
            If cmd = 240 Then
              Inc lenI
              c = 1
            Else
              c = 1
            Endif
              For c = 0 To lenI - 1
                legge_byte()
              Next
              Break
  
          Case 255          ' Meta-evento
            c = legge_byte()
            lenI = legge_var()
            If lenI < 0 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
            Select Case c
              Case 33
                If lenI < 1 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
                legge_byte()
                salto(lenI - 1)
              Case 47                     ' Fine traccia
                totale_tick_traccia = tick
                If nmt = "1" Then t1 = "   (del Tempo)"
                f = (((60000000 / Fix(60000000 / Val("&" & bpm$))) / rTD) * totale_tick_traccia) / 1000000
                If f > 0 Then tempus = Str(Date(0, 0, 0, 0, 0, 0, f * 1000))
                If IsNull(tempus) Then tempus = "00:00:00"
                Print "Traccia";; nmt; ": "; "   "; tempus; t1
                Print "------------------------------------"
                  
                Return f
  
              Case 81
                If lenI < 3 Then Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
                bpm$ = Hex(legge_byte(), 2)
                bpm$ &= Hex(legge_byte(), 2)
                bpm$ &= Hex(legge_byte(), 2)
                salto(lenI - 3)
              Case Else         ' Ignora gli altri Meta-eventi
                salto(lenI)

            End Select
          Case Else     ' Comando Fx non valido
            Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
        End Select
      Case Else
        Error.Raise("Dati Midi non validi (offset " & file_offset & ") !")
    End Select
    
  Wend
  
End


Private Function legge_var() As Integer   ' Legge un numero a lunghezza-variabile (tempo Delta)
 
 Dim valore As Integer
 Dim c As Byte
 
  Read #fl, c
  valore = c And 127
  If c And 128 Then
    Read #fl, c
    valore = (valore * CInt(2 ^ 7)) Or (c And 127)
    If c And 128 Then
      Read #fl, c
      valore = (valore * CInt(2 ^ 7)) Or (c And 127)
      If c And 128 Then
        Read #fl, c
        valore = (valore * CInt(2 ^ 7)) Or c
        If c And 128 Then Return -1
      Endif
    Endif
  Endif
  
  Return valore
  
End


Private Function legge_byte() As Byte
 
 Dim b As Byte
 
  Inc file_offset
 
  Read #fl, b
   
  Return b
 
End


Private Procedure salto(b As Byte)
 
  While b > 0
    legge_byte()
    Dec b
  Wend
  file_offset += b
   
End


Private Function legge_dal_file(by As Short) As Integer
 
 Dim valore As Integer
 Dim b As Byte
  
  Do
    Read #fl, b
    If b = -1 Then Return -1
    valore = (valore * CInt(2 ^ 8)) Or b
    Dec by
  Loop Until by = 0
   
  Return valore
 
End
Estratto da "https://www.gambas-it.org/wiki/index.php?title=Conoscere_la_durata_di_un_file_Midi_con_le_sole_risorse_di_Gambas&oldid=18460"