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= | + | 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