長いですが、ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。
MIDIファイルの詳細についてはWikipedia等を参照ください。
興味ある方は、ご自由にご利用ください。
2016/2/6
SMF1に対応させました。ユーザーインターフェースをマルチトラックに対応させるのが面倒だったので、1トラックだけ対応です。
--------------------------------------------------
Option Explicit
'==================================================
'MIDIファイルの構造 (SMF, Standard Midi File)
'<HeaderChunk> + <TrackChunk> + <TrackChunk> ...
'
'MIDIファイルには複数のフォーマットがある (SMF0, SMF1, SMF2)
'SMF0 : TrackChunkは1つ
'SMF1 : TrackChunkは複数 (1つのTrackには1つのChannelが対応, 最初のTrackにはテンポなどの情報だけ入れる(コンダクタトラック))
'SMF2 : 使われていないらしいので省略
'==================================================
'<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(可変長)について
'最上位bitが1なら、次の1byteもデータと見なす
'(1xxx xxxx 1yyy yyyy 0zzz zzzz) は (xxx xxxx yyy yyyy zzz zzzz)を意味する
'最大4bytes (データは最大で28bits)
'
'==================================================
'<ChannelEvent>
'DeltaTime variable, 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はパーカッションに固定されている) (SMF1なら1つのTrackが1つのChannel、1つの楽器に対応する)
'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, Big Endian, 直前のMidiEventからの時間 (tick単位)
'EventType 1byte, 0xF0 or 0xF7
'DataLength variable, Dataのサイズ(byte単位)
'Data
'
'Dataが長い場合は､複数のSystem Eventにすることもある(送信エラーも起こりうる)
'Dataの最初なら､System EventはF0で始める
'分割されたDataの途中なら､System EventはF7で始める(variableは分割されたDataのサイズ)
'Dataの最後にはF7を付ける (variableにはF7の1byteも含める)
'==================================================
'<Meta Event>
'DeltaTime variable, Big Endian, 直前のMidiEventからの時間 (tick単位)
'EventType 1byte, 0xFF
'MetaEventType 1byte, 種類はたくさんある
'DataLength variable, 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
'==================================================
Private Type HEADER_CHUNK
ChunkID As String * 4
ChunkSize As Long
FormatType As Integer
NumberOfTracks As Integer
TimeDivision As Integer
End Type
Private Type TRACK_CHUNK
ChunkID As String * 4
ChunkSize As Long
Data() As Byte
End Type
Private Type MIDI_EVENT
DeltaTime As Long
EventType As Byte
Param1 As Byte
Param2 As Byte
End Type
Public Sub seq_sample()
Dim i As Long
Dim note() As String
Dim key1 As Byte
Dim key2 As Byte
Dim time_step As Long
Dim time_count As Long
ReDim note(11) As String
note(0) = "C": note(1) = "C#": note(2) = "D": note(3) = "D#"
note(4) = "E": note(5) = "F": note(6) = "F#": note(7) = "G"
note(8) = "G#": note(9) = "A": note(10) = "A#": note(11) = "B"
Sheet1.Cells.ClearContents
'------------------------------
Sheet1.Cells(1, 1) = "Program No. : "
Sheet1.Cells(1, 2) = 0
'------------------------------
key1 = 48
key2 = 83
Sheet1.Cells(2, 1) = "Key"
For i = 0 To key2 - key1
Sheet1.Cells(3 + i, 1) = key2 - i
Sheet1.Cells(3 + i, 2) = note((key2 - i) Mod 12)
Next i
'------------------------------
time_step = 24
time_count = 480 '四分音符1個 = 0.5sec = 96tickのときの60secに相当
Sheet1.Cells(1, 3) = "Key"
For i = 0 To time_count - 1
Sheet1.Cells(2, 3 + i) = i * time_step
Next i
Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, 2 + time_count)).ColumnWidth = 4
'------------------------------
Sheet1.Cells(26, 3) = "on"
Sheet1.Cells(26, 4) = "off"
Sheet1.Cells(24, 4) = "on"
Sheet1.Cells(24, 5) = "off"
Sheet1.Cells(22, 5) = "on"
Sheet1.Cells(22, 6) = "off"
Sheet1.Cells(21, 6) = "on"
Sheet1.Cells(21, 7) = "off"
Sheet1.Cells(19, 7) = "on"
Sheet1.Cells(19, 8) = "off"
Sheet1.Cells(17, 8) = "on"
Sheet1.Cells(17, 9) = "off"
Sheet1.Cells(15, 9) = "on"
Sheet1.Cells(15, 10) = "off"
Sheet1.Cells(14, 10) = "on"
Sheet1.Cells(14, 14) = "off"
'------------------------------
ActiveWindow.FreezePanes = False
Sheet1.Cells(3, 3).Select
ActiveWindow.FreezePanes = True
End Sub
Public Sub seq_write()
Dim i As Long
Dim j As Long
Dim row As Long
Dim col As Long
Dim count As Long
Dim str As String
Dim prg As Byte
Dim ch As Byte
Dim time As Long
Dim time_last As Long
Dim key As Byte
Dim filename As String
Dim hChunk As HEADER_CHUNK
Dim tChunk() As TRACK_CHUNK
Dim midi() As MIDI_EVENT
'------------------------------
hChunk.ChunkID = "MThd"
hChunk.ChunkSize = 6
hChunk.FormatType = 1
hChunk.NumberOfTracks = 2
hChunk.TimeDivision = 96
'------------------------------
ReDim tChunk(1) As TRACK_CHUNK
'------------------------------
ReDim midi(0) As MIDI_EVENT
setMidi midi(0), 0, &HFF, &H2F, &H0
encodeMidi tChunk(0), midi, 1
Erase midi
'------------------------------
'MidiEventイベントの数を調べる
row = Sheet1.Cells(3, 1).End(xlDown).row - 2
col = Sheet1.Cells(2, 3).End(xlToRight).column - 2
count = 0
For i = 0 To col - 1
For j = 0 To row - 1
str = Sheet1.Cells(3 + j, 3 + i)
If str = "on" Then
count = count + 1
ElseIf str = "off" Then
count = count + 1
Else
End If
Next j
Next i
'------------------------------
ReDim midi(count + 1) As MIDI_EVENT
prg = CByte(Sheet1.Cells(1, 2))
ch = CByte(1)
count = 0
time = 0
time_last = 0
setMidi midi(count), 0, &HC0, prg, &H0
count = count + 1
For i = 0 To col - 1
For j = 0 To row - 1
str = Sheet1.Cells(3 + j, 3 + i)
time = Sheet1.Cells(2, 3 + i)
key = CByte(Sheet1.Cells(3 + j, 1))
If str = "on" Then
setMidi midi(count), time - time_last, CByte(&H90 + ch), key, &H7F
count = count + 1
time_last = time
ElseIf str = "off" Then
setMidi midi(count), time - time_last, CByte(&H80 + ch), key, &H7F
count = count + 1
time_last = time
Else
End If
Next j
Next i
setMidi midi(count), 0, &HFF, &H2F, &H0
count = count + 1
encodeMidi tChunk(1), midi, count
Erase midi
'------------------------------
ChDir ThisWorkbook.Path
filename = "sequence.mid"
writeMidi filename, hChunk, tChunk
End Sub
Private Sub setMidi(ByRef midi As MIDI_EVENT, dt As Long, et As Byte, p1 As Byte, p2 As Byte)
midi.DeltaTime = dt
midi.EventType = et
midi.Param1 = p1
midi.Param2 = p2
End Sub
Private Sub encodeMidi(ByRef tChunk As TRACK_CHUNK, ByRef midi() As MIDI_EVENT, ByRef size As Long)
Dim i As Long
Dim j As Long
Dim temp1 As Byte
Dim temp4 As Long
Dim buf() As Byte
ReDim buf(size * 8 - 1) As Byte
i = 0
For j = 0 To size - 1
'------------------------------
'DeltaTime
temp4 = 128
Do While temp4 <= midi(j).DeltaTime
temp4 = temp4 * 128
Loop
Do While 128 < temp4
temp4 = temp4 \ 128
buf(i) = CByte((midi(j).DeltaTime \ temp4) Mod 128 + &H80)
i = i + 1
Loop
buf(i) = CByte(midi(j).DeltaTime Mod 128)
i = i + 1
'------------------------------
'EventType
If 0 < j And midi(j).EventType < &HF0 And midi(j).EventType = temp1 Then
'running status
Else
temp1 = midi(j).EventType
buf(i) = temp1
i = i + 1
End If
'------------------------------
'Data
If temp1 < &HF0 Then
If &HC0 <= temp1 And temp1 < &HE0 Then
buf(i) = midi(j).Param1
i = i + 1
Else
buf(i) = midi(j).Param1
buf(i + 1) = midi(j).Param2
i = i + 2
End If
Else
'System Event, Meta Eventには未対応
End If
'------------------------------
'Track終端メッセージ
If midi(j).EventType = &HFF And midi(j).Param1 = &H2F Then
buf(i) = &H2F
buf(i + 1) = &H0
i = i + 2
Exit For
End If
'------------------------------
Next j
tChunk.ChunkID = "MTrk"
tChunk.ChunkSize = i
ReDim tChunk.Data(tChunk.ChunkSize - 1) As Byte
For j = 0 To i - 1
tChunk.Data(j) = buf(j)
Next j
Erase buf
End Sub
Private Sub decodeMidi(ByRef tChunk As TRACK_CHUNK, ByRef midi() As MIDI_EVENT, ByRef size As Long)
Dim i As Long
Dim j As Long
Dim temp1 As Byte
Dim temp4 As Long
Dim buf() As MIDI_EVENT
ReDim buf(tChunk.ChunkSize / 2 - 1) As MIDI_EVENT
i = 0
j = 0
Do While i < tChunk.ChunkSize
'------------------------------
'DeltaTime
temp4 = tChunk.Data(i) And &H7F
i = i + 1
Do While (tChunk.Data(i - 1) And &H80) = &H80
temp4 = temp4 * 128 + (tChunk.Data(i) And &H7F)
i = i + 1
Loop
buf(j).DeltaTime = temp4
'------------------------------
'EventType
If (tChunk.Data(i) And &H80) = &H80 Then
temp1 = tChunk.Data(i)
i = i + 1
End If
buf(j).EventType = temp1
'------------------------------
'Data
If temp1 < &HF0 Then
If &HC0 <= temp1 And temp1 < &HE0 Then
buf(j).Param1 = tChunk.Data(i)
buf(j).Param2 = 0
i = i + 1
Else
buf(j).Param1 = tChunk.Data(i)
buf(j).Param2 = tChunk.Data(i + 1)
i = i + 2
End If
Else
'System Event, Meta Eventには未対応
If temp1 = &HFF Then
buf(j).Param1 = tChunk.Data(i)
i = i + 1
End If
temp4 = tChunk.Data(i) And &H7F
i = i + 1
Do While (tChunk.Data(i - 1) And &H80) = &H80
temp4 = temp4 * 128 + (tChunk.Data(i) And &H7F)
i = i + 1
Loop
i = i + temp4
End If
'------------------------------
j = j + 1
Loop
size = j
ReDim midi(size - 1) As MIDI_EVENT
For i = 0 To j - 1
midi(i).DeltaTime = buf(i).DeltaTime
midi(i).EventType = buf(i).EventType
midi(i).Param1 = buf(i).Param1
midi(i).Param2 = buf(i).Param2
Next i
Erase buf
End Sub
'ファイルに書き込む
Private Sub writeMidi(filename As String, ByRef hChunk As HEADER_CHUNK, ByRef tChunk() As TRACK_CHUNK)
Dim i As Long
Dim buf2(1) As Byte
Dim buf4(3) As Byte
Open filename For Binary As 1
'------------------------------
Put 1, , hChunk.ChunkID
buf4(3) = CByte(hChunk.ChunkSize Mod 256)
buf4(2) = CByte((hChunk.ChunkSize \ 256) Mod 256)
buf4(1) = CByte(((hChunk.ChunkSize \ 256) \ 256) Mod 256)
buf4(0) = CByte((((hChunk.ChunkSize \ 256) \ 256) \ 256) Mod 256)
Put 1, , buf4
buf2(1) = CByte(hChunk.FormatType)
buf2(0) = CByte(0)
Put 1, , buf2
buf2(1) = CByte(hChunk.NumberOfTracks Mod 256)
buf2(0) = CByte((hChunk.NumberOfTracks \ 256) Mod 256)
Put 1, , buf2
buf2(1) = CByte(hChunk.TimeDivision Mod 256)
buf2(0) = CByte((hChunk.TimeDivision \ 256) Mod 256)
Put 1, , buf2
'------------------------------
For i = 0 To hChunk.NumberOfTracks - 1
Put 1, , tChunk(i).ChunkID
buf4(3) = CByte(tChunk(i).ChunkSize Mod 256)
buf4(2) = CByte((tChunk(i).ChunkSize \ 256) Mod 256)
buf4(1) = CByte(((tChunk(i).ChunkSize \ 256) \ 256) Mod 256)
buf4(0) = CByte((((tChunk(i).ChunkSize \ 256) \ 256) \ 256) Mod 256)
Put 1, , buf4
Put 1, , tChunk(i).Data
Next i
'------------------------------
Close 1
End Sub
'ファイルから読み込む
Private Sub readMidi(filename As String, ByRef hChunk As HEADER_CHUNK, ByRef tChunk() As TRACK_CHUNK)
Dim i As Long
Dim buf2(1) As Byte
Dim buf4(3) As Byte
On Error GoTo Label1
Open filename For Binary As 1
'------------------------------
Get 1, , buf4
hChunk.ChunkID = Chr(buf4(0)) & Chr(buf4(1)) & Chr(buf4(2)) & Chr(buf4(3))
Get 1, , buf4
hChunk.ChunkSize = ((CLng(buf4(0)) * 256 + buf4(1)) * 256 + buf4(2)) * 256 + buf4(3)
Get 1, , buf2
hChunk.FormatType = CInt(buf2(0)) * 256 + buf2(1)
Get 1, , buf2
hChunk.NumberOfTracks = CInt(buf2(0)) * 256 + buf2(1)
Get 1, , buf2
hChunk.TimeDivision = CInt(buf2(0)) * 256 + buf2(1)
ReDim tChunk(hChunk.NumberOfTracks - 1) As TRACK_CHUNK
'------------------------------
For i = 0 To hChunk.NumberOfTracks - 1
Get 1, , buf4
tChunk(i).ChunkID = Chr(buf4(0)) & Chr(buf4(1)) & Chr(buf4(2)) & Chr(buf4(3))
Get 1, , buf4
tChunk(i).ChunkSize = ((CLng(buf4(0)) * 256 + buf4(1)) * 256 + buf4(2)) * 256 + buf4(3)
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
'==================================================
'MIDIファイルの構造 (SMF, Standard Midi File)
'<HeaderChunk> + <TrackChunk> + <TrackChunk> ...
'
'MIDIファイルには複数のフォーマットがある (SMF0, SMF1, SMF2)
'SMF0 : TrackChunkは1つ
'SMF1 : TrackChunkは複数 (1つのTrackには1つのChannelが対応, 最初のTrackにはテンポなどの情報だけ入れる(コンダクタトラック))
'SMF2 : 使われていないらしいので省略
'==================================================
'<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(可変長)について
'最上位bitが1なら、次の1byteもデータと見なす
'(1xxx xxxx 1yyy yyyy 0zzz zzzz) は (xxx xxxx yyy yyyy zzz zzzz)を意味する
'最大4bytes (データは最大で28bits)
'
'==================================================
'<ChannelEvent>
'DeltaTime variable, 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はパーカッションに固定されている) (SMF1なら1つのTrackが1つのChannel、1つの楽器に対応する)
'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, Big Endian, 直前のMidiEventからの時間 (tick単位)
'EventType 1byte, 0xF0 or 0xF7
'DataLength variable, Dataのサイズ(byte単位)
'Data
'
'Dataが長い場合は､複数のSystem Eventにすることもある(送信エラーも起こりうる)
'Dataの最初なら､System EventはF0で始める
'分割されたDataの途中なら､System EventはF7で始める(variableは分割されたDataのサイズ)
'Dataの最後にはF7を付ける (variableにはF7の1byteも含める)
'==================================================
'<Meta Event>
'DeltaTime variable, Big Endian, 直前のMidiEventからの時間 (tick単位)
'EventType 1byte, 0xFF
'MetaEventType 1byte, 種類はたくさんある
'DataLength variable, 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
'==================================================
Private Type HEADER_CHUNK
ChunkID As String * 4
ChunkSize As Long
FormatType As Integer
NumberOfTracks As Integer
TimeDivision As Integer
End Type
Private Type TRACK_CHUNK
ChunkID As String * 4
ChunkSize As Long
Data() As Byte
End Type
Private Type MIDI_EVENT
DeltaTime As Long
EventType As Byte
Param1 As Byte
Param2 As Byte
End Type
Public Sub seq_sample()
Dim i As Long
Dim note() As String
Dim key1 As Byte
Dim key2 As Byte
Dim time_step As Long
Dim time_count As Long
ReDim note(11) As String
note(0) = "C": note(1) = "C#": note(2) = "D": note(3) = "D#"
note(4) = "E": note(5) = "F": note(6) = "F#": note(7) = "G"
note(8) = "G#": note(9) = "A": note(10) = "A#": note(11) = "B"
Sheet1.Cells.ClearContents
'------------------------------
Sheet1.Cells(1, 1) = "Program No. : "
Sheet1.Cells(1, 2) = 0
'------------------------------
key1 = 48
key2 = 83
Sheet1.Cells(2, 1) = "Key"
For i = 0 To key2 - key1
Sheet1.Cells(3 + i, 1) = key2 - i
Sheet1.Cells(3 + i, 2) = note((key2 - i) Mod 12)
Next i
'------------------------------
time_step = 24
time_count = 480 '四分音符1個 = 0.5sec = 96tickのときの60secに相当
Sheet1.Cells(1, 3) = "Key"
For i = 0 To time_count - 1
Sheet1.Cells(2, 3 + i) = i * time_step
Next i
Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1, 2 + time_count)).ColumnWidth = 4
'------------------------------
Sheet1.Cells(26, 3) = "on"
Sheet1.Cells(26, 4) = "off"
Sheet1.Cells(24, 4) = "on"
Sheet1.Cells(24, 5) = "off"
Sheet1.Cells(22, 5) = "on"
Sheet1.Cells(22, 6) = "off"
Sheet1.Cells(21, 6) = "on"
Sheet1.Cells(21, 7) = "off"
Sheet1.Cells(19, 7) = "on"
Sheet1.Cells(19, 8) = "off"
Sheet1.Cells(17, 8) = "on"
Sheet1.Cells(17, 9) = "off"
Sheet1.Cells(15, 9) = "on"
Sheet1.Cells(15, 10) = "off"
Sheet1.Cells(14, 10) = "on"
Sheet1.Cells(14, 14) = "off"
'------------------------------
ActiveWindow.FreezePanes = False
Sheet1.Cells(3, 3).Select
ActiveWindow.FreezePanes = True
End Sub
Public Sub seq_write()
Dim i As Long
Dim j As Long
Dim row As Long
Dim col As Long
Dim count As Long
Dim str As String
Dim prg As Byte
Dim ch As Byte
Dim time As Long
Dim time_last As Long
Dim key As Byte
Dim filename As String
Dim hChunk As HEADER_CHUNK
Dim tChunk() As TRACK_CHUNK
Dim midi() As MIDI_EVENT
'------------------------------
hChunk.ChunkID = "MThd"
hChunk.ChunkSize = 6
hChunk.FormatType = 1
hChunk.NumberOfTracks = 2
hChunk.TimeDivision = 96
'------------------------------
ReDim tChunk(1) As TRACK_CHUNK
'------------------------------
ReDim midi(0) As MIDI_EVENT
setMidi midi(0), 0, &HFF, &H2F, &H0
encodeMidi tChunk(0), midi, 1
Erase midi
'------------------------------
'MidiEventイベントの数を調べる
row = Sheet1.Cells(3, 1).End(xlDown).row - 2
col = Sheet1.Cells(2, 3).End(xlToRight).column - 2
count = 0
For i = 0 To col - 1
For j = 0 To row - 1
str = Sheet1.Cells(3 + j, 3 + i)
If str = "on" Then
count = count + 1
ElseIf str = "off" Then
count = count + 1
Else
End If
Next j
Next i
'------------------------------
ReDim midi(count + 1) As MIDI_EVENT
prg = CByte(Sheet1.Cells(1, 2))
ch = CByte(1)
count = 0
time = 0
time_last = 0
setMidi midi(count), 0, &HC0, prg, &H0
count = count + 1
For i = 0 To col - 1
For j = 0 To row - 1
str = Sheet1.Cells(3 + j, 3 + i)
time = Sheet1.Cells(2, 3 + i)
key = CByte(Sheet1.Cells(3 + j, 1))
If str = "on" Then
setMidi midi(count), time - time_last, CByte(&H90 + ch), key, &H7F
count = count + 1
time_last = time
ElseIf str = "off" Then
setMidi midi(count), time - time_last, CByte(&H80 + ch), key, &H7F
count = count + 1
time_last = time
Else
End If
Next j
Next i
setMidi midi(count), 0, &HFF, &H2F, &H0
count = count + 1
encodeMidi tChunk(1), midi, count
Erase midi
'------------------------------
ChDir ThisWorkbook.Path
filename = "sequence.mid"
writeMidi filename, hChunk, tChunk
End Sub
Private Sub setMidi(ByRef midi As MIDI_EVENT, dt As Long, et As Byte, p1 As Byte, p2 As Byte)
midi.DeltaTime = dt
midi.EventType = et
midi.Param1 = p1
midi.Param2 = p2
End Sub
Private Sub encodeMidi(ByRef tChunk As TRACK_CHUNK, ByRef midi() As MIDI_EVENT, ByRef size As Long)
Dim i As Long
Dim j As Long
Dim temp1 As Byte
Dim temp4 As Long
Dim buf() As Byte
ReDim buf(size * 8 - 1) As Byte
i = 0
For j = 0 To size - 1
'------------------------------
'DeltaTime
temp4 = 128
Do While temp4 <= midi(j).DeltaTime
temp4 = temp4 * 128
Loop
Do While 128 < temp4
temp4 = temp4 \ 128
buf(i) = CByte((midi(j).DeltaTime \ temp4) Mod 128 + &H80)
i = i + 1
Loop
buf(i) = CByte(midi(j).DeltaTime Mod 128)
i = i + 1
'------------------------------
'EventType
If 0 < j And midi(j).EventType < &HF0 And midi(j).EventType = temp1 Then
'running status
Else
temp1 = midi(j).EventType
buf(i) = temp1
i = i + 1
End If
'------------------------------
'Data
If temp1 < &HF0 Then
If &HC0 <= temp1 And temp1 < &HE0 Then
buf(i) = midi(j).Param1
i = i + 1
Else
buf(i) = midi(j).Param1
buf(i + 1) = midi(j).Param2
i = i + 2
End If
Else
'System Event, Meta Eventには未対応
End If
'------------------------------
'Track終端メッセージ
If midi(j).EventType = &HFF And midi(j).Param1 = &H2F Then
buf(i) = &H2F
buf(i + 1) = &H0
i = i + 2
Exit For
End If
'------------------------------
Next j
tChunk.ChunkID = "MTrk"
tChunk.ChunkSize = i
ReDim tChunk.Data(tChunk.ChunkSize - 1) As Byte
For j = 0 To i - 1
tChunk.Data(j) = buf(j)
Next j
Erase buf
End Sub
Private Sub decodeMidi(ByRef tChunk As TRACK_CHUNK, ByRef midi() As MIDI_EVENT, ByRef size As Long)
Dim i As Long
Dim j As Long
Dim temp1 As Byte
Dim temp4 As Long
Dim buf() As MIDI_EVENT
ReDim buf(tChunk.ChunkSize / 2 - 1) As MIDI_EVENT
i = 0
j = 0
Do While i < tChunk.ChunkSize
'------------------------------
'DeltaTime
temp4 = tChunk.Data(i) And &H7F
i = i + 1
Do While (tChunk.Data(i - 1) And &H80) = &H80
temp4 = temp4 * 128 + (tChunk.Data(i) And &H7F)
i = i + 1
Loop
buf(j).DeltaTime = temp4
'------------------------------
'EventType
If (tChunk.Data(i) And &H80) = &H80 Then
temp1 = tChunk.Data(i)
i = i + 1
End If
buf(j).EventType = temp1
'------------------------------
'Data
If temp1 < &HF0 Then
If &HC0 <= temp1 And temp1 < &HE0 Then
buf(j).Param1 = tChunk.Data(i)
buf(j).Param2 = 0
i = i + 1
Else
buf(j).Param1 = tChunk.Data(i)
buf(j).Param2 = tChunk.Data(i + 1)
i = i + 2
End If
Else
'System Event, Meta Eventには未対応
If temp1 = &HFF Then
buf(j).Param1 = tChunk.Data(i)
i = i + 1
End If
temp4 = tChunk.Data(i) And &H7F
i = i + 1
Do While (tChunk.Data(i - 1) And &H80) = &H80
temp4 = temp4 * 128 + (tChunk.Data(i) And &H7F)
i = i + 1
Loop
i = i + temp4
End If
'------------------------------
j = j + 1
Loop
size = j
ReDim midi(size - 1) As MIDI_EVENT
For i = 0 To j - 1
midi(i).DeltaTime = buf(i).DeltaTime
midi(i).EventType = buf(i).EventType
midi(i).Param1 = buf(i).Param1
midi(i).Param2 = buf(i).Param2
Next i
Erase buf
End Sub
'ファイルに書き込む
Private Sub writeMidi(filename As String, ByRef hChunk As HEADER_CHUNK, ByRef tChunk() As TRACK_CHUNK)
Dim i As Long
Dim buf2(1) As Byte
Dim buf4(3) As Byte
Open filename For Binary As 1
'------------------------------
Put 1, , hChunk.ChunkID
buf4(3) = CByte(hChunk.ChunkSize Mod 256)
buf4(2) = CByte((hChunk.ChunkSize \ 256) Mod 256)
buf4(1) = CByte(((hChunk.ChunkSize \ 256) \ 256) Mod 256)
buf4(0) = CByte((((hChunk.ChunkSize \ 256) \ 256) \ 256) Mod 256)
Put 1, , buf4
buf2(1) = CByte(hChunk.FormatType)
buf2(0) = CByte(0)
Put 1, , buf2
buf2(1) = CByte(hChunk.NumberOfTracks Mod 256)
buf2(0) = CByte((hChunk.NumberOfTracks \ 256) Mod 256)
Put 1, , buf2
buf2(1) = CByte(hChunk.TimeDivision Mod 256)
buf2(0) = CByte((hChunk.TimeDivision \ 256) Mod 256)
Put 1, , buf2
'------------------------------
For i = 0 To hChunk.NumberOfTracks - 1
Put 1, , tChunk(i).ChunkID
buf4(3) = CByte(tChunk(i).ChunkSize Mod 256)
buf4(2) = CByte((tChunk(i).ChunkSize \ 256) Mod 256)
buf4(1) = CByte(((tChunk(i).ChunkSize \ 256) \ 256) Mod 256)
buf4(0) = CByte((((tChunk(i).ChunkSize \ 256) \ 256) \ 256) Mod 256)
Put 1, , buf4
Put 1, , tChunk(i).Data
Next i
'------------------------------
Close 1
End Sub
'ファイルから読み込む
Private Sub readMidi(filename As String, ByRef hChunk As HEADER_CHUNK, ByRef tChunk() As TRACK_CHUNK)
Dim i As Long
Dim buf2(1) As Byte
Dim buf4(3) As Byte
On Error GoTo Label1
Open filename For Binary As 1
'------------------------------
Get 1, , buf4
hChunk.ChunkID = Chr(buf4(0)) & Chr(buf4(1)) & Chr(buf4(2)) & Chr(buf4(3))
Get 1, , buf4
hChunk.ChunkSize = ((CLng(buf4(0)) * 256 + buf4(1)) * 256 + buf4(2)) * 256 + buf4(3)
Get 1, , buf2
hChunk.FormatType = CInt(buf2(0)) * 256 + buf2(1)
Get 1, , buf2
hChunk.NumberOfTracks = CInt(buf2(0)) * 256 + buf2(1)
Get 1, , buf2
hChunk.TimeDivision = CInt(buf2(0)) * 256 + buf2(1)
ReDim tChunk(hChunk.NumberOfTracks - 1) As TRACK_CHUNK
'------------------------------
For i = 0 To hChunk.NumberOfTracks - 1
Get 1, , buf4
tChunk(i).ChunkID = Chr(buf4(0)) & Chr(buf4(1)) & Chr(buf4(2)) & Chr(buf4(3))
Get 1, , buf4
tChunk(i).ChunkSize = ((CLng(buf4(0)) * 256 + buf4(1)) * 256 + buf4(2)) * 256 + buf4(3)
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
0 件のコメント:
コメントを投稿