Excel VBAで、MIDIファイルを操作するモジュールを作ってみました。適当なMIDIメッセージからMIDIファイルを作る、みたいなことができます。
ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。
MIDIファイルは仕様が少し面倒で、MIDIのイベントの知識が必要です。というわけでソースコードも長くなってしまいました。
MIDIファイルの詳細についてはWikipedia等を参照ください。
興味ある方は、ご自由にご利用ください。
2016/2/6 更新
SMF1にも対応できるように変更しました。
2016/12/24 更新
MIDI EventをCollectionで扱うように変更しました (プログラムが簡単になるから)。そのため、新たに、MIDI Eventのクラスモジュールを作っています。
ここから下はMIDIフォーマットのメモ
MIDIファイルの構造 (SMF, Standard Midi File)
<HeaderChunk> + <TrackChunk> + <TrackChunk> ...
MIDIファイルには複数のフォーマットがある (SMF0, SMF1, SMF2)
SMF0 : TrackChunkは1つ
SMF1 : TrackChunkは複数
SMF2 : 使われていないらしいので省略
SMF1では、1つのTrackには1つのChannel (1つの楽器) が対応
SMF1では、最初のTrackにはテンポなどの情報だけ入れる(コンダクタトラック)
--------------------------------------------------
<HeaderChunk>
ChunkID 4bytes, "MThd"
ChunkSize 4bytes, Big Endian, 6
FormatType 2bytes, Big Endian, 0 or 1
NumberOfTracks 2bytes, Big Endian, SMF0なら1
TimeDivision 2bytes, Big Endian
--------------------------------------------------
TimeDivisionについて
(1) bit15が0の場合(0*** **** **** ****)
4分音符の分割数 (48, 96, 960, etc)
4分音符の実際の時間は、MidiEventのMetaEventで設定可能 (デフォルトは0.5sec)
(2) bit15が1の場合(1aaa aaaa bbbb bbbb)
1aaa aaaaが1秒間のフレーム数 (-24, -25, -29, -30)
bbbb bbbbが1フレームの分解能 (4, 8, 10, 80, 100, etc)
(1)を使うことが多い
なお、MIDIでは最小時間単位をtickという
--------------------------------------------------
<TrackChunk>
ChunkID 4bytes, "MTrk"
ChunkSize 4bytes, Big Endian
Data MidiEventの配列
MidiEventには､ChannelEvent , SystemEvent, MetaEventの3種類ある(最初の1byteで区別する)
--------------------------------------------------
variable length (可変長)について
最上位bitが1なら、次の1byteもデータと見なす
(1xxx xxxx 1yyy yyyy 0zzz zzzz) は (xxx xxxx yyy yyyy zzz zzzz)を意味する
最大4bytes (データは最大で28bits)
--------------------------------------------------
<ChannelEvent>
DeltaTime variable length, Big Endian, 直前のMidiEventからの時間 (tick単位)
EventType 1byte, 0x80-0xEF
Param1 1byte
Param2 1byte, EventTypeによっては存在しない
0x 8n kk vv 3bytes, Note Off
0x 9n kk vv 3bytes, Note On
0x An kk vv 3bytes, Note Aftertouch
0x Bn cc dd 3bytes, Controller
0x Cn pp 2bytes, Program Change
0x Dn vv 2bytes, Channel Aftertouch
0x En ll mm 3bytes, Pitch Bend
n 4bits, 0-15, Channel Number
kk 1byte, 0-127, Note Number
vv 1byte, 0-127, Velocity
cc 1byte, 0-127, Controller Type
dd 1byte, 0-127, Controller Value
pp 1byte, 0-127, Program Number
ll 1byte, 0-127, Pitch Value
mm 1byte, 0-127, Pitch Value
ChannelEventでは、同じChannelEventが連続するときは、2回目以降が省略可能 (Running Status)
1つのChannelには1つの楽器を対応させる (n=9はパーカッションに固定されている)
ControllerについてはWikipedia etcを参照
Program NumberについてはWikipedia etcを参照
llとmmは2つで1つのパラメータ(0-16383、8192のときはPitchの変更なし)
ll=0xxxxxxx, mm=0yyyyyyyは、yyyyyyyxxxxxxxを意味する(Little Endian)
--------------------------------------------------
<SystemEvent>
DeltaTime variable length, Big Endian, 直前のMidiEventからの時間 (tick単位)
EventType 1byte, 0xF0 or 0xF7
DataLength variable length, Dataのサイズ(byte単位)
Data
Dataが長い場合は､複数のSystem Eventにすることもある(送信エラーも起こりうる)
Dataの最初なら､System EventはF0で始める
分割されたDataの途中なら､System EventはF7で始める(variable lengthは分割されたDataのサイズ)
Dataの最後にはF7を付ける (variable lengthにはF7の1byteも含める)
--------------------------------------------------
<Meta Event>
DeltaTime variable length, Big Endian, 直前のMidiEventからの時間 (tick単位)
EventType 1byte, 0xFF
MetaEventType 1byte, 種類はたくさんある
DataLength variable length, Dataのサイズ(byte単位)
Data
0x FF 00 シーケンス番号 (Dataは2bytes)
0x FF 01 テキスト
0x FF 02 著作権
0x FF 03 シーケンス名
0x FF 04 楽器名
0x FF 05 歌詞
0x FF 06 マーカー
0x FF 07 キューポイント
0x FF 20 MIDIチャンネルプリフィックス (Dataは1byte)
0x FF 21 ポート指定 (Dataは1byte。非標準。)
0x FF 2F トラック終端 (必須。Dataは0byte)
0x FF 51 テンポ (Dataは3bytes) 4分音符の秒数(usec単位) デフォルトは500000usec
0x FF 54 オフセット (Dataは3bytes) hr mn se fr ff 0-23, 0-59, 0-59, 0-30, 0-99の値をとるらしい
0x FF 58 拍子 (Dataは4bytes) 4/4拍子とか
0x FF 59 調号 (Dataは2bytes) シャープ、フラット、長調、短調
0x FF 7F シーケンサー特定メタイベント
--------------------------------------------------
参考URL
http://ja.wikipedia.org/wiki/General_MIDI
http://www.midi.org/techspecs/midimessages.php
ここから下がクラスモジュール (MIDI_EVENTクラス)
Option Explicit
Public DeltaTime As Long
Public EventType As Byte
Public Param1 As Byte
Public Param2 As Byte
Public Sub SetEvent(dt As Long, evt As Byte, p1 As Byte, p2 As Byte)
DeltaTime = dt
EventType = evt
Param1 = p1
Param2 = p2
End Sub
ここから下が標準モジュール
Option Explicit
Private Type HEADER_CHUNK
ChunkID As String * 4
ChunkSize As Long
FormatType As Integer
NumberOfTracks As Integer
TimeDivision As Integer
End Type
Private hChunk As HEADER_CHUNK
Private Type TRACK_CHUNK
ChunkID As String * 4
ChunkSize As Long
data() As Byte
End Type
Private tChunk() As TRACK_CHUNK
Public Sub write_sample()
Dim filename As String
'--------------------------------------------------
ReDim tChunk(0) As TRACK_CHUNK
Dim midi As Collection
Set midi = New Collection
Dim temp As MIDI_EVENT
Set temp = New MIDI_EVENT
temp.SetEvent 0, &HC0, &H0, &H0
midi.Add temp
Set temp = New MIDI_EVENT
temp.SetEvent 0, &H90, &H3C, &H7F
midi.Add temp
Set temp = New MIDI_EVENT
temp.SetEvent 384, &H80, &H3C, &H7F
midi.Add temp
'--------------------------------------------------
encode tChunk(0), midi
filename = ThisWorkbook.Path + "\test.mid"
writeMidi filename
End Sub
Public Sub read_sample()
Dim filename As String
Dim i As Long
Dim j As Long
Dim midi As Collection
Dim row As Long
Sheet1.Cells.Clear
filename = Application.GetOpenFilename("midi, *.mid")
If filename = "False" Then
Exit Sub
End If
readMidi filename
'--------------------------------------------------
Sheet1.Cells(1, 1) = "HeaderChunk"
Sheet1.Cells(2, 1) = "ChunkID"
Sheet1.Cells(3, 1) = "ChunkSize"
Sheet1.Cells(4, 1) = "FormatType"
Sheet1.Cells(5, 1) = "NumberOfTracks"
Sheet1.Cells(6, 1) = "TimeDivision"
'--------------------------------------------------
Sheet1.Cells(2, 2) = hChunk.ChunkID
Sheet1.Cells(3, 2) = hChunk.ChunkSize
Sheet1.Cells(4, 2) = hChunk.FormatType
Sheet1.Cells(5, 2) = hChunk.NumberOfTracks
Sheet1.Cells(6, 2) = hChunk.TimeDivision
'--------------------------------------------------
row = 8
For i = 0 To hChunk.NumberOfTracks - 1
Set midi = New Collection
Sheet1.Cells(row, 1) = "TrackChunk"
Sheet1.Cells(row + 1, 1) = "ChunkID"
Sheet1.Cells(row + 2, 1) = "ChunkSize"
Sheet1.Cells(row, 2) = i
Sheet1.Cells(row + 1, 2) = tChunk(i).ChunkID
Sheet1.Cells(row + 2, 2) = tChunk(i).ChunkSize
Sheet1.Cells(row + 3, 1) = "DeltaTime"
Sheet1.Cells(row + 3, 2) = "EventType"
Sheet1.Cells(row + 3, 3) = "Param1"
Sheet1.Cells(row + 3, 4) = "Param2"
row = row + 4
decode tChunk(i), midi
For j = 1 To midi.Count
Sheet1.Cells(row, 1) = midi(j).DeltaTime
Sheet1.Cells(row, 2) = Hex(midi(j).EventType)
Sheet1.Cells(row, 3) = midi(j).Param1
Sheet1.Cells(row, 4) = midi(j).Param2
row = row + 1
Next j
row = row + 1
Next i
'--------------------------------------------------
End Sub
'ファイルに書き込む
'SMF0のみ対応
Public Sub writeMidi(filename As String)
Dim i As Long
Dim hc(13) As Byte
Dim tc(7) As Byte
hChunk.ChunkID = "MThd"
hChunk.ChunkSize = 6
hChunk.FormatType = 0
hChunk.NumberOfTracks = 1
hChunk.TimeDivision = 96
Open filename For Binary As 1
'--------------------------------------------------
hc(0) = Asc("M")
hc(1) = Asc("T")
hc(2) = Asc("h")
hc(3) = Asc("d")
hc(4) = CByte((((hChunk.ChunkSize \ 256) \ 256) \ 256) Mod 256)
hc(5) = CByte(((hChunk.ChunkSize \ 256) \ 256) Mod 256)
hc(6) = CByte((hChunk.ChunkSize \ 256) Mod 256)
hc(7) = CByte(hChunk.ChunkSize Mod 256)
hc(8) = CByte((hChunk.FormatType \ 256) Mod 256)
hc(9) = CByte(hChunk.FormatType Mod 256)
hc(10) = CByte((hChunk.NumberOfTracks \ 256) Mod 256)
hc(11) = CByte(hChunk.NumberOfTracks Mod 256)
hc(12) = CByte((hChunk.TimeDivision \ 256) Mod 256)
hc(13) = CByte(hChunk.TimeDivision Mod 256)
Put 1, , hc
'--------------------------------------------------
For i = 0 To hChunk.NumberOfTracks - 1
tChunk(i).ChunkID = "MTrk"
tc(0) = Asc("M")
tc(1) = Asc("T")
tc(2) = Asc("r")
tc(3) = Asc("k")
tc(4) = CByte((((tChunk(i).ChunkSize \ 256) \ 256) \ 256) Mod 256)
tc(5) = CByte(((tChunk(i).ChunkSize \ 256) \ 256) Mod 256)
tc(6) = CByte((tChunk(i).ChunkSize \ 256) Mod 256)
tc(7) = CByte(tChunk(i).ChunkSize Mod 256)
Put 1, , tc
Put 1, , tChunk(i).data
Next i
'--------------------------------------------------
Close 1
End Sub
'ファイルから読み込む
Public Sub readMidi(filename As String)
Dim i As Long
Dim hc(13) As Byte
Dim tc(7) As Byte
On Error GoTo Label1
Open filename For Binary As 1
'--------------------------------------------------
Get 1, , hc
hChunk.ChunkID = Chr(hc(0)) & Chr(hc(1)) & Chr(hc(2)) & Chr(hc(3))
hChunk.ChunkSize = ((CLng(hc(4)) * 256 + hc(5)) * 256 + hc(6)) * 256 + hc(7)
hChunk.FormatType = CInt(hc(8)) * 256 + hc(9)
hChunk.NumberOfTracks = CInt(hc(10)) * 256 + hc(11)
hChunk.TimeDivision = CInt(hc(12)) * 256 + hc(13)
'--------------------------------------------------
ReDim tChunk(hChunk.NumberOfTracks - 1) As TRACK_CHUNK
For i = 0 To hChunk.NumberOfTracks - 1
Get 1, , tc
tChunk(i).ChunkID = Chr(tc(0)) & Chr(tc(1)) & Chr(tc(2)) & Chr(tc(3))
tChunk(i).ChunkSize = ((CLng(tc(4)) * 256 + tc(5)) * 256 + tc(6)) * 256 + tc(7)
ReDim tChunk(i).data(tChunk(i).ChunkSize - 1) As Byte
Get 1, , tChunk(i).data
Next i
'--------------------------------------------------
Close 1
Exit Sub
Label1:
Close 1
MsgBox "error", vbExclamation
End Sub
Public Sub encode(ByRef track As TRACK_CHUNK, ByRef midi As Collection)
Dim i As Long
Dim N As Long
Dim buf() As Byte
Dim temp1 As Byte
Dim temp4 As Long
ReDim buf(midi.Count * 8) As Byte
N = 0
For i = 1 To midi.Count
'--------------------------------------------------
'DeltaTime
temp4 = 128
Do While temp4 <= midi(i).DeltaTime
temp4 = temp4 * 128
Loop
Do While 128 < temp4
temp4 = temp4 \ 128
buf(N) = CByte((midi(i).DeltaTime \ temp4) Mod 128 + &H80)
N = N + 1
Loop
buf(N) = CByte(midi(i).DeltaTime Mod 128)
N = N + 1
'--------------------------------------------------
'EventType
If 0 < N And midi(i).EventType < &HF0 And midi(i).EventType = temp1 Then
'running status
Else
temp1 = midi(i).EventType
buf(N) = temp1
N = N + 1
End If
'--------------------------------------------------
'Data
If temp1 < &HF0 Then
If &HC0 <= temp1 And temp1 < &HE0 Then
buf(N) = midi(i).Param1
N = N + 1
Else
buf(N) = midi(i).Param1
buf(N + 1) = midi(i).Param2
N = N + 2
End If
Else
'System Event, Meta Eventには未対応
End If
'--------------------------------------------------
Next i
'Track終端メッセージ
buf(N) = &H0
buf(N + 1) = &HFF
buf(N + 2) = &H2F
buf(N + 3) = &H0
N = N + 4
track.ChunkID = "MTrk"
track.ChunkSize = N
ReDim track.data(track.ChunkSize - 1) As Byte
For i = 0 To track.ChunkSize - 1
track.data(i) = buf(i)
Next i
Erase buf
End Sub
Public Sub decode(ByRef tc As TRACK_CHUNK, ByRef midi As Collection)
Dim d_pos As Long
Dim temp As MIDI_EVENT
Dim evt As Byte
Dim dt As Long
d_pos = 0
Do While d_pos < tc.ChunkSize
Set temp = New MIDI_EVENT
'--------------------------------------------------
'DeltaTime
dt = tc.data(d_pos) And &H7F
d_pos = d_pos + 1
Do While &H80 <= tc.data(d_pos - 1)
dt = dt * 128 + (tc.data(d_pos) And &H7F)
d_pos = d_pos + 1
Loop
temp.DeltaTime = dt
'--------------------------------------------------
'EventType
If &H80 <= tc.data(d_pos) Then
evt = tc.data(d_pos)
d_pos = d_pos + 1
End If
temp.EventType = evt
'--------------------------------------------------
'Data
If evt < &HF0 Then
If &HC0 <= evt And evt < &HE0 Then
temp.Param1 = tc.data(d_pos)
temp.Param2 = 0
d_pos = d_pos + 1
Else
temp.Param1 = tc.data(d_pos)
temp.Param2 = tc.data(d_pos + 1)
d_pos = d_pos + 2
End If
Else
'System Event, Meta Eventには未対応
If evt = &HFF Then
temp.Param1 = tc.data(d_pos)
d_pos = d_pos + 1
End If
dt = tc.data(d_pos) And &H7F
d_pos = d_pos + 1
Do While &H80 <= tc.data(d_pos - 1)
dt = dt * 128 + (tc.data(d_pos) And &H7F)
d_pos = d_pos + 1
Loop
d_pos = d_pos + dt
End If
'--------------------------------------------------
midi.Add temp
Loop
End Sub
Public DeltaTime As Long
Public EventType As Byte
Public Param1 As Byte
Public Param2 As Byte
Public Sub SetEvent(dt As Long, evt As Byte, p1 As Byte, p2 As Byte)
DeltaTime = dt
EventType = evt
Param1 = p1
Param2 = p2
End Sub
ここから下が標準モジュール
Option Explicit
Private Type HEADER_CHUNK
ChunkID As String * 4
ChunkSize As Long
FormatType As Integer
NumberOfTracks As Integer
TimeDivision As Integer
End Type
Private hChunk As HEADER_CHUNK
Private Type TRACK_CHUNK
ChunkID As String * 4
ChunkSize As Long
data() As Byte
End Type
Private tChunk() As TRACK_CHUNK
Public Sub write_sample()
Dim filename As String
'--------------------------------------------------
ReDim tChunk(0) As TRACK_CHUNK
Dim midi As Collection
Set midi = New Collection
Dim temp As MIDI_EVENT
Set temp = New MIDI_EVENT
temp.SetEvent 0, &HC0, &H0, &H0
midi.Add temp
Set temp = New MIDI_EVENT
temp.SetEvent 0, &H90, &H3C, &H7F
midi.Add temp
Set temp = New MIDI_EVENT
temp.SetEvent 384, &H80, &H3C, &H7F
midi.Add temp
'--------------------------------------------------
encode tChunk(0), midi
filename = ThisWorkbook.Path + "\test.mid"
writeMidi filename
End Sub
Public Sub read_sample()
Dim filename As String
Dim i As Long
Dim j As Long
Dim midi As Collection
Dim row As Long
Sheet1.Cells.Clear
filename = Application.GetOpenFilename("midi, *.mid")
If filename = "False" Then
Exit Sub
End If
readMidi filename
'--------------------------------------------------
Sheet1.Cells(1, 1) = "HeaderChunk"
Sheet1.Cells(2, 1) = "ChunkID"
Sheet1.Cells(3, 1) = "ChunkSize"
Sheet1.Cells(4, 1) = "FormatType"
Sheet1.Cells(5, 1) = "NumberOfTracks"
Sheet1.Cells(6, 1) = "TimeDivision"
'--------------------------------------------------
Sheet1.Cells(2, 2) = hChunk.ChunkID
Sheet1.Cells(3, 2) = hChunk.ChunkSize
Sheet1.Cells(4, 2) = hChunk.FormatType
Sheet1.Cells(5, 2) = hChunk.NumberOfTracks
Sheet1.Cells(6, 2) = hChunk.TimeDivision
'--------------------------------------------------
row = 8
For i = 0 To hChunk.NumberOfTracks - 1
Set midi = New Collection
Sheet1.Cells(row, 1) = "TrackChunk"
Sheet1.Cells(row + 1, 1) = "ChunkID"
Sheet1.Cells(row + 2, 1) = "ChunkSize"
Sheet1.Cells(row, 2) = i
Sheet1.Cells(row + 1, 2) = tChunk(i).ChunkID
Sheet1.Cells(row + 2, 2) = tChunk(i).ChunkSize
Sheet1.Cells(row + 3, 1) = "DeltaTime"
Sheet1.Cells(row + 3, 2) = "EventType"
Sheet1.Cells(row + 3, 3) = "Param1"
Sheet1.Cells(row + 3, 4) = "Param2"
row = row + 4
decode tChunk(i), midi
For j = 1 To midi.Count
Sheet1.Cells(row, 1) = midi(j).DeltaTime
Sheet1.Cells(row, 2) = Hex(midi(j).EventType)
Sheet1.Cells(row, 3) = midi(j).Param1
Sheet1.Cells(row, 4) = midi(j).Param2
row = row + 1
Next j
row = row + 1
Next i
'--------------------------------------------------
End Sub
'ファイルに書き込む
'SMF0のみ対応
Public Sub writeMidi(filename As String)
Dim i As Long
Dim hc(13) As Byte
Dim tc(7) As Byte
hChunk.ChunkID = "MThd"
hChunk.ChunkSize = 6
hChunk.FormatType = 0
hChunk.NumberOfTracks = 1
hChunk.TimeDivision = 96
Open filename For Binary As 1
'--------------------------------------------------
hc(0) = Asc("M")
hc(1) = Asc("T")
hc(2) = Asc("h")
hc(3) = Asc("d")
hc(4) = CByte((((hChunk.ChunkSize \ 256) \ 256) \ 256) Mod 256)
hc(5) = CByte(((hChunk.ChunkSize \ 256) \ 256) Mod 256)
hc(6) = CByte((hChunk.ChunkSize \ 256) Mod 256)
hc(7) = CByte(hChunk.ChunkSize Mod 256)
hc(8) = CByte((hChunk.FormatType \ 256) Mod 256)
hc(9) = CByte(hChunk.FormatType Mod 256)
hc(10) = CByte((hChunk.NumberOfTracks \ 256) Mod 256)
hc(11) = CByte(hChunk.NumberOfTracks Mod 256)
hc(12) = CByte((hChunk.TimeDivision \ 256) Mod 256)
hc(13) = CByte(hChunk.TimeDivision Mod 256)
Put 1, , hc
'--------------------------------------------------
For i = 0 To hChunk.NumberOfTracks - 1
tChunk(i).ChunkID = "MTrk"
tc(0) = Asc("M")
tc(1) = Asc("T")
tc(2) = Asc("r")
tc(3) = Asc("k")
tc(4) = CByte((((tChunk(i).ChunkSize \ 256) \ 256) \ 256) Mod 256)
tc(5) = CByte(((tChunk(i).ChunkSize \ 256) \ 256) Mod 256)
tc(6) = CByte((tChunk(i).ChunkSize \ 256) Mod 256)
tc(7) = CByte(tChunk(i).ChunkSize Mod 256)
Put 1, , tc
Put 1, , tChunk(i).data
Next i
'--------------------------------------------------
Close 1
End Sub
'ファイルから読み込む
Public Sub readMidi(filename As String)
Dim i As Long
Dim hc(13) As Byte
Dim tc(7) As Byte
On Error GoTo Label1
Open filename For Binary As 1
'--------------------------------------------------
Get 1, , hc
hChunk.ChunkID = Chr(hc(0)) & Chr(hc(1)) & Chr(hc(2)) & Chr(hc(3))
hChunk.ChunkSize = ((CLng(hc(4)) * 256 + hc(5)) * 256 + hc(6)) * 256 + hc(7)
hChunk.FormatType = CInt(hc(8)) * 256 + hc(9)
hChunk.NumberOfTracks = CInt(hc(10)) * 256 + hc(11)
hChunk.TimeDivision = CInt(hc(12)) * 256 + hc(13)
'--------------------------------------------------
ReDim tChunk(hChunk.NumberOfTracks - 1) As TRACK_CHUNK
For i = 0 To hChunk.NumberOfTracks - 1
Get 1, , tc
tChunk(i).ChunkID = Chr(tc(0)) & Chr(tc(1)) & Chr(tc(2)) & Chr(tc(3))
tChunk(i).ChunkSize = ((CLng(tc(4)) * 256 + tc(5)) * 256 + tc(6)) * 256 + tc(7)
ReDim tChunk(i).data(tChunk(i).ChunkSize - 1) As Byte
Get 1, , tChunk(i).data
Next i
'--------------------------------------------------
Close 1
Exit Sub
Label1:
Close 1
MsgBox "error", vbExclamation
End Sub
Public Sub encode(ByRef track As TRACK_CHUNK, ByRef midi As Collection)
Dim i As Long
Dim N As Long
Dim buf() As Byte
Dim temp1 As Byte
Dim temp4 As Long
ReDim buf(midi.Count * 8) As Byte
N = 0
For i = 1 To midi.Count
'--------------------------------------------------
'DeltaTime
temp4 = 128
Do While temp4 <= midi(i).DeltaTime
temp4 = temp4 * 128
Loop
Do While 128 < temp4
temp4 = temp4 \ 128
buf(N) = CByte((midi(i).DeltaTime \ temp4) Mod 128 + &H80)
N = N + 1
Loop
buf(N) = CByte(midi(i).DeltaTime Mod 128)
N = N + 1
'--------------------------------------------------
'EventType
If 0 < N And midi(i).EventType < &HF0 And midi(i).EventType = temp1 Then
'running status
Else
temp1 = midi(i).EventType
buf(N) = temp1
N = N + 1
End If
'--------------------------------------------------
'Data
If temp1 < &HF0 Then
If &HC0 <= temp1 And temp1 < &HE0 Then
buf(N) = midi(i).Param1
N = N + 1
Else
buf(N) = midi(i).Param1
buf(N + 1) = midi(i).Param2
N = N + 2
End If
Else
'System Event, Meta Eventには未対応
End If
'--------------------------------------------------
Next i
'Track終端メッセージ
buf(N) = &H0
buf(N + 1) = &HFF
buf(N + 2) = &H2F
buf(N + 3) = &H0
N = N + 4
track.ChunkID = "MTrk"
track.ChunkSize = N
ReDim track.data(track.ChunkSize - 1) As Byte
For i = 0 To track.ChunkSize - 1
track.data(i) = buf(i)
Next i
Erase buf
End Sub
Public Sub decode(ByRef tc As TRACK_CHUNK, ByRef midi As Collection)
Dim d_pos As Long
Dim temp As MIDI_EVENT
Dim evt As Byte
Dim dt As Long
d_pos = 0
Do While d_pos < tc.ChunkSize
Set temp = New MIDI_EVENT
'--------------------------------------------------
'DeltaTime
dt = tc.data(d_pos) And &H7F
d_pos = d_pos + 1
Do While &H80 <= tc.data(d_pos - 1)
dt = dt * 128 + (tc.data(d_pos) And &H7F)
d_pos = d_pos + 1
Loop
temp.DeltaTime = dt
'--------------------------------------------------
'EventType
If &H80 <= tc.data(d_pos) Then
evt = tc.data(d_pos)
d_pos = d_pos + 1
End If
temp.EventType = evt
'--------------------------------------------------
'Data
If evt < &HF0 Then
If &HC0 <= evt And evt < &HE0 Then
temp.Param1 = tc.data(d_pos)
temp.Param2 = 0
d_pos = d_pos + 1
Else
temp.Param1 = tc.data(d_pos)
temp.Param2 = tc.data(d_pos + 1)
d_pos = d_pos + 2
End If
Else
'System Event, Meta Eventには未対応
If evt = &HFF Then
temp.Param1 = tc.data(d_pos)
d_pos = d_pos + 1
End If
dt = tc.data(d_pos) And &H7F
d_pos = d_pos + 1
Do While &H80 <= tc.data(d_pos - 1)
dt = dt * 128 + (tc.data(d_pos) And &H7F)
d_pos = d_pos + 1
Loop
d_pos = d_pos + dt
End If
'--------------------------------------------------
midi.Add temp
Loop
End Sub
0 件のコメント:
コメントを投稿