Differenze tra le versioni di "Conoscere la durata di un file Midi con le sole risorse di Gambas"
Da Gambas-it.org - Wikipedia.
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, nel quale si otterranno anche le durate delle singole tracce ''MTrk'' presenti nel file ed alcune generiche informazioni: |
Private fl As File | Private fl As File | ||
Riga 13: | Riga 13: | ||
fileMidi = "''/percorso/del/file.mid''" | fileMidi = "''/percorso/del/file.mid''" | ||
Print "File Midi:";; fileMidi | Print "File Midi:";; fileMidi | ||
+ | Print "Dimensione:";; Stat(fileMidi).Size;; "byte" | ||
fl = Open fileMidi For Read | fl = Open fileMidi For Read | ||
Riga 30: | Riga 31: | ||
Dim lung_MThd, tipo, risoluzione_TD, lenI As Integer | Dim lung_MThd, tipo, risoluzione_TD, lenI As Integer | ||
− | Dim | + | Dim num_tracce As Short |
Dim err, traccia As Byte | Dim err, traccia As Byte | ||
Dim s As String | Dim s As String | ||
Riga 41: | Riga 42: | ||
tipo = legge_dal_file(2) | tipo = legge_dal_file(2) | ||
If (tipo <> 0) And (tipo <> 1) Then Error.Raise("Il tipo " & tipo & " non è supportato !") | If (tipo <> 0) And (tipo <> 1) Then Error.Raise("Il tipo " & tipo & " non è supportato !") | ||
+ | Print "Tipo file Midi:";; tipo | ||
− | + | num_tracce = legge_dal_file(2) | |
− | If ( | + | If (num_tracce < 1) Or (num_tracce > 1000) Then Error.Raise(num_tracce & ": è un numero di tracce non valido !") |
− | Print " | + | Print "Numero totale Tracce:";; num_tracce |
risoluzione_TD = legge_dal_file(2) | risoluzione_TD = legge_dal_file(2) | ||
If risoluzione_TD < 0 Then Error.Raise("Formato di file non valido !") | If risoluzione_TD < 0 Then Error.Raise("Formato di file non valido !") | ||
+ | Print "Risoluzione Tempo Delta:";; risoluzione_TD | ||
+ | |||
+ | Print "\n\n=== DURATA delle";; num_tracce;; "TRACCE ===\n" | ||
<FONT Color=gray>' ''Legge le tracce MTrk del file Midi:''</font> | <FONT Color=gray>' ''Legge le tracce MTrk del file Midi:''</font> | ||
− | For traccia = 1 To | + | For traccia = 1 To num_tracce |
<FONT Color=gray>' ''Cerca il blocco "Mtrk" della traccia corrente:''</font> | <FONT Color=gray>' ''Cerca il blocco "Mtrk" della traccia corrente:''</font> | ||
For err = 0 To 1 | For err = 0 To 1 |
Versione delle 08:54, 23 ago 2015
Per conoscere la durata di un file Midi 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:
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 Print "Dimensione:";; Stat(fileMidi).Size;; "byte" 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_tracce 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 !") Print "Tipo file Midi:";; tipo num_tracce = legge_dal_file(2) If (num_tracce < 1) Or (num_tracce > 1000) Then Error.Raise(num_tracce & ": è un numero di tracce non valido !") Print "Numero totale Tracce:";; num_tracce risoluzione_TD = legge_dal_file(2) If risoluzione_TD < 0 Then Error.Raise("Formato di file non valido !") Print "Risoluzione Tempo Delta:";; risoluzione_TD Print "\n\n=== DURATA delle";; num_tracce;; "TRACCE ===\n" ' Legge le tracce MTrk del file Midi: For traccia = 1 To num_tracce ' 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 ' Legge una intera singola traccia Mtrk 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