このブログの目的の一つは、私の作文の練習です。色々なことに当てはまりますが、作文も練習しないと上達しません。また、ただ練習するよりも、うまいやり方を知っておくのが上達のコツです。というわけで、作文のための文章の構成方法を調べてみました。
まず「起承転結」という構成ですが、これは漢詩に由来する文章の構成です。小学生のときに習うので、一般的なものだと思っていたのですが、実はローカルな構成だそうです。学生の頃に習った杜甫の漢詩は美しかったという記憶がありますが、その構成は特別な場合みたいです。もちろん、使ってはいけない、ということはありません。
三幕構成もしくは序破急という構成は、映画の脚本などで国際的に使われる構成です。設定、対立、解決という流れです。桃から生まれる、鬼を倒す、めでたしめでたし、みたいな感じでしょうか。ストーリーを書くならこれがいいでしょう。
パラグラフ・ライティングは英語圏での文章の基本的な構成です。序論、本論、結論という流れです。序論で主張を述べて、本論で根拠などを示し、結論で再度主張を述べるいう感じです。ビジネスなどでは、パラグラフ・ライティングの構成が分かりやすいと思います。
学術論文はIMRADという構成で書きます。つまりIntroduction、Methods、Results、and Discussionという流れです。私も実験レポートはこういう流れで書くようにしています。
文章を書いていると、起承転結をどうするかで迷ったりしたのですが、起承転結にこだわらずに、内容に合わせて、構成を変えるのが良いみたいです。逆に、文章を読んでいるときには、どのような構成かを考えてみると、勉強になりそうです。今後はそういったことも意識してみようと思います。
・・・私も、まだまだ勉強が足りないです。
参考：Wikipedia
2015年1月17日土曜日
ExcelでMIDI
MIDIファイルを編集したい、ってことありますよね(?)
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クラス)
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
ExcelでWave
Waveファイルを編集したい、ってことありますよね(?)
Excel VBAでWaveファイルを操作するモジュールを作ってみました。適当な波形を作ってWaveファイルに保存する、みたいなことができます。
ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。
Waveファイルの詳細についてはWikipedia等を参照ください。
興味ある方は、ご自由にご利用ください。(保証はありませんが orz)
2016/1/4
変数を構造体に変更しました。適当なエラー処理もいれました。気分です。
********************************************************************************
Excel VBAでWaveファイルを操作するモジュールを作ってみました。適当な波形を作ってWaveファイルに保存する、みたいなことができます。
ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。
Waveファイルの詳細についてはWikipedia等を参照ください。
興味ある方は、ご自由にご利用ください。(保証はありませんが orz)
2016/1/4
変数を構造体に変更しました。適当なエラー処理もいれました。気分です。
********************************************************************************
Option Explicit
'--------------------------------------------------
'Waveファイルの構造
'<RIFFChunk> + <SubChunk> + <SubChunk>
'
'SubChunkにはいくつか種類がある(fmt , data, fact, LIST)
'fmt + dataの場合にのみ対応
'fact, LISTについてはパス
'--------------------------------------------------
'<RIFFChunk>
'ChunkID 4bytes "RIFF"
'ChunkSize 4bytes これ以降のファイルサイズ (byte単位)
'Format 4bytes "WAVE"
'--------------------------------------------------
'<fmt>
'SubchunkID 4bytes "fmt ", スペースありの4文字
'SubchunkSize 4bytes SubChunkDataのサイズ, byte単位, "fmt "なら16
'AudioFormat 2bytes フォーマットID, リニアPCMなら1
'NumChannels 2bytes チャンネル数, モノラルは1, ステレオは2
'SampleRate 4bytes サンプリングレート, Hz単位, 8kHz, 44.1kHz, etc
'ByteRate 4bytes データ速度, bytes/sec単位, 44.1kHz ステレオ, 16bitsなら176400
'BlockAlign 2bytes ブロックサイズ, bytes/sample単位, ステレオ, 16bitsなら4
'BitsPerSample 2bytes サンプルサイズ, bits/sample単位, WAVEフォーマットでは8bits or 16bits
'--------------------------------------------------
'<data>
'SubchunkID 4bytes "data"
'SubchunkSize 4bytes SubChunkDataのサイズ, byte単位
'data
'ステレオの場合、LRLR・・・の順
'8bitsなら符号なし(0～255、128が無音)
'16bitsなら符号つき (-32768～32767、0が無音)
'--------------------------------------------------
'<RIFFChunk>
Private Type RIFF_CHUNK
ChunkID As String * 4
ChunkSize As Long
Format As String * 4
End Type
Private riffChunk As RIFF_CHUNK
'<fmt>
Private Type fmt_chunk
SubchunkID As String * 4
SubchunkSize As Long
AudioFormat As Integer
NumChannels As Integer
SampleRate As Long
ByteRate As Long
BlockAlign As Integer
BitsPerSample As Integer
End Type
Private fmtChunk As fmt_chunk
'<data>
Private Type DATA_CHUNK
SubchunkID As String * 4
SubchunkSize As Long
End Type
Private dataChunk As DATA_CHUNK
Public Const PI = 3.1415926535
Public Sub test()
Dim i As Long
Dim freq As Long '正弦波の周波数, ヒトの可聴域は20Hz～20000Hzくらい
Dim time As Double
Dim sampling As Long
Dim length As Long
Dim data() As Byte
Dim filename As String
'------------------------------
'データの作成
freq = 1000
time = 0.5
sampling = 8000
length = sampling * time
ReDim data(length - 1) As Byte
For i = 0 To length - 1
data(i) = CByte(128 + 127 * Sin(2 * PI * freq * i / sampling))
Next i
'------------------------------
filename = ThisWorkbook.Path + "\test.wav"
'ファイルに書き出す
writeWave filename, sampling, length, data
'ファイルから読み込む
readWave filename, sampling, length, data
End Sub
'Waveファイルの書き出し
'リニアPCM, モノラル, 8bitsのみ対応
Private Sub writeWave(filename As String, SampleRate As Long, length As Long, data() As Byte)
riffChunk.ChunkID = "RIFF"
riffChunk.ChunkSize = length + 36
riffChunk.Format = "WAVE"
fmtChunk.SubchunkID = "fmt "
fmtChunk.SubchunkSize = 16
fmtChunk.AudioFormat = 1
fmtChunk.NumChannels = 1
fmtChunk.SampleRate = SampleRate
fmtChunk.ByteRate = SampleRate
fmtChunk.BlockAlign = 1
fmtChunk.BitsPerSample = 8
dataChunk.SubchunkID = "data"
dataChunk.SubchunkSize = length
Open filename For Binary As 1
Put 1, , riffChunk
Put 1, , fmtChunk
Put 1, , dataChunk
Put 1, , data
Close 1
End Sub
'Waveファイルの読み込み
'リニアPCM, モノラル, 8bitsのみ対応
Private Sub readWave(filename As String, ByRef SampleRate As Long, ByRef length As Long, ByRef data() As Byte)
On Error GoTo Label1
Open filename For Binary As 1
Get 1, , riffChunk
If riffChunk.ChunkID <> "RIFF" Then GoTo Label1
If riffChunk.Format <> "WAVE" Then GoTo Label1
Get 1, , fmtChunk
If fmtChunk.SubchunkID <> "fmt " Then GoTo Label1
If fmtChunk.AudioFormat <> 1 Then GoTo Label1
If fmtChunk.NumChannels <> 1 Then GoTo Label1
If fmtChunk.BitsPerSample <> 8 Then GoTo Label1
Get 1, , dataChunk
If dataChunk.SubchunkID <> "data" Then GoTo Label1
'
ReDim data(dataChunk.SubchunkSize) As Byte
Get 1, , data
SampleRate = fmtChunk.SampleRate
length = dataChunk.SubchunkSize
Close 1
Exit Sub
Label1:
Close 1
MsgBox "error", vbExclamation
End Sub
********************************************************************************
'--------------------------------------------------
'Waveファイルの構造
'<RIFFChunk> + <SubChunk> + <SubChunk>
'
'SubChunkにはいくつか種類がある(fmt , data, fact, LIST)
'fmt + dataの場合にのみ対応
'fact, LISTについてはパス
'--------------------------------------------------
'<RIFFChunk>
'ChunkID 4bytes "RIFF"
'ChunkSize 4bytes これ以降のファイルサイズ (byte単位)
'Format 4bytes "WAVE"
'--------------------------------------------------
'<fmt>
'SubchunkID 4bytes "fmt ", スペースありの4文字
'SubchunkSize 4bytes SubChunkDataのサイズ, byte単位, "fmt "なら16
'AudioFormat 2bytes フォーマットID, リニアPCMなら1
'NumChannels 2bytes チャンネル数, モノラルは1, ステレオは2
'SampleRate 4bytes サンプリングレート, Hz単位, 8kHz, 44.1kHz, etc
'ByteRate 4bytes データ速度, bytes/sec単位, 44.1kHz ステレオ, 16bitsなら176400
'BlockAlign 2bytes ブロックサイズ, bytes/sample単位, ステレオ, 16bitsなら4
'BitsPerSample 2bytes サンプルサイズ, bits/sample単位, WAVEフォーマットでは8bits or 16bits
'--------------------------------------------------
'<data>
'SubchunkID 4bytes "data"
'SubchunkSize 4bytes SubChunkDataのサイズ, byte単位
'data
'ステレオの場合、LRLR・・・の順
'8bitsなら符号なし(0～255、128が無音)
'16bitsなら符号つき (-32768～32767、0が無音)
'--------------------------------------------------
'<RIFFChunk>
Private Type RIFF_CHUNK
ChunkID As String * 4
ChunkSize As Long
Format As String * 4
End Type
Private riffChunk As RIFF_CHUNK
'<fmt>
Private Type fmt_chunk
SubchunkID As String * 4
SubchunkSize As Long
AudioFormat As Integer
NumChannels As Integer
SampleRate As Long
ByteRate As Long
BlockAlign As Integer
BitsPerSample As Integer
End Type
Private fmtChunk As fmt_chunk
'<data>
Private Type DATA_CHUNK
SubchunkID As String * 4
SubchunkSize As Long
End Type
Private dataChunk As DATA_CHUNK
Public Const PI = 3.1415926535
Public Sub test()
Dim i As Long
Dim freq As Long '正弦波の周波数, ヒトの可聴域は20Hz～20000Hzくらい
Dim time As Double
Dim sampling As Long
Dim length As Long
Dim data() As Byte
Dim filename As String
'------------------------------
'データの作成
freq = 1000
time = 0.5
sampling = 8000
length = sampling * time
ReDim data(length - 1) As Byte
For i = 0 To length - 1
data(i) = CByte(128 + 127 * Sin(2 * PI * freq * i / sampling))
Next i
'------------------------------
filename = ThisWorkbook.Path + "\test.wav"
'ファイルに書き出す
writeWave filename, sampling, length, data
'ファイルから読み込む
readWave filename, sampling, length, data
End Sub
'Waveファイルの書き出し
'リニアPCM, モノラル, 8bitsのみ対応
Private Sub writeWave(filename As String, SampleRate As Long, length As Long, data() As Byte)
riffChunk.ChunkID = "RIFF"
riffChunk.ChunkSize = length + 36
riffChunk.Format = "WAVE"
fmtChunk.SubchunkID = "fmt "
fmtChunk.SubchunkSize = 16
fmtChunk.AudioFormat = 1
fmtChunk.NumChannels = 1
fmtChunk.SampleRate = SampleRate
fmtChunk.ByteRate = SampleRate
fmtChunk.BlockAlign = 1
fmtChunk.BitsPerSample = 8
dataChunk.SubchunkID = "data"
dataChunk.SubchunkSize = length
Open filename For Binary As 1
Put 1, , riffChunk
Put 1, , fmtChunk
Put 1, , dataChunk
Put 1, , data
Close 1
End Sub
'Waveファイルの読み込み
'リニアPCM, モノラル, 8bitsのみ対応
Private Sub readWave(filename As String, ByRef SampleRate As Long, ByRef length As Long, ByRef data() As Byte)
On Error GoTo Label1
Open filename For Binary As 1
Get 1, , riffChunk
If riffChunk.ChunkID <> "RIFF" Then GoTo Label1
If riffChunk.Format <> "WAVE" Then GoTo Label1
Get 1, , fmtChunk
If fmtChunk.SubchunkID <> "fmt " Then GoTo Label1
If fmtChunk.AudioFormat <> 1 Then GoTo Label1
If fmtChunk.NumChannels <> 1 Then GoTo Label1
If fmtChunk.BitsPerSample <> 8 Then GoTo Label1
Get 1, , dataChunk
If dataChunk.SubchunkID <> "data" Then GoTo Label1
'
ReDim data(dataChunk.SubchunkSize) As Byte
Get 1, , data
SampleRate = fmtChunk.SampleRate
length = dataChunk.SubchunkSize
Close 1
Exit Sub
Label1:
Close 1
MsgBox "error", vbExclamation
End Sub
********************************************************************************
ExcelでBitmap
Bitmapファイルのピクセルを編集したい、ってことありますよね(?)
Excel VBAでBitmapファイルを操作するモジュールを作ってみました。各ピクセルに適当な色を設定して、Bitmapファイルに保存する、みたいなことができます。
ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。
Bitmapファイルの詳細についてはWikipedia等を参照ください。
興味ある方は、ご自由にご利用ください。(・・・保証はありませんが orz)
2016/1/4
変数を構造体に変更しました。わざわざ構造体にしなくてもいいんですが、気分です。
********************************************************************************
Option Explicit
'--------------------------------------------------
'Bitmapファイルの構造
'<BITMAPFILEHEADER構造体> + <BITMAPINFOHEADER構造体> + <カラーパレット> + <画像データ>
'--------------------------------------------------
'<BITMAPFILEHEADER構造体>
'bfType 2bytes "BM"
'bfSize 4bytes ファイルサイズ, byte単位
'bfReserved1 2bytes 予約領域
'bfReserved2 2bytes 予約領域
'bfOffBits 4bytes ファイル先頭から画像データまでのオフセット, byte単位
'--------------------------------------------------
'<BITMAPINFOHEADER構造体>
'biSize 4bytes BITMAPINFOHEADERのサイズ
'biWidth 4bytes 画像の幅, pixel単位
'biHeight 4bytes 画像の高さ, pixel単位
'biPlanes 2bytes プレーン数, 常に1
'biBitCount 2bytes 1画素当たりのデータサイズ, 1,4,8,24,32bitのいずれか
'biCompression 4bytes 圧縮形式, 無圧縮なら0
'biSizeImage 4bytes 画像データ部のサイズ, 0でもOK
'biXPixPerMeter 4bytes 横方向解像度, 1m当たりの画素数, 0でもOK
'biYPixPerMeter 4bytes 縦方向解像度, 1m当たりの画素数, 0でもOK
'biClrUsed 4bytes 格納されているパレット数, 0でもOK
'biClrImportant 4bytes 重要なパレットのインデックス, 0でもOK
'--------------------------------------------------
'<カラーパレット>
'1, 4, 8bitカラーの場合はカラーパレットのRGB値
'24, 32bitカラーの場合はない
'--------------------------------------------------
'<画像データ>
'1, 4, 8bitカラーの場合は、カラーパレットの値
'24, 32bitカラーの場合は、RGB値の配列
'画像の1ラインのデータ長は4の倍数byteじゃないとダメ (biWidth * biBitCount / 8 が 4の倍数)
'--------------------------------------------------
'<BITMAPFILEHEADER構造体>
Private Type BITMAP_FILE_HEADER
bfType As String * 2
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private bfHeader As BITMAP_FILE_HEADER
'<BITMAPINFOHEADER構造体>
Private Type BITMAP_INFO_HEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPixPerMeter As Long
biYPixPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private biHeader As BITMAP_INFO_HEADER
Public Sub test()
Dim i As Long
Dim j As Long
Dim width As Long
Dim height As Long
Dim pos As Long
Dim data() As Byte
Dim filename As String
'------------------------------
'データの作成
width = 256
height = 128
ReDim data(width * height * 3 - 1) As Byte
For i = 0 To height - 1
For j = 0 To width - 1
pos = (width * i + j) * 3
data(pos + 0) = CByte(255) 'Blue
data(pos + 1) = CByte(255 / height * i) 'Green
data(pos + 2) = CByte(255 / width * j) 'Red
Next j
Next i
'------------------------------
filename = ThisWorkbook.Path + "\test.bmp"
'ファイルに書き出す
writeBitmap filename, data, width, height
'ファイルから読み込む
readBitmap filename, data, width, height
End Sub
'Bitmapファイルの書き出し
'24bitフルカラーのみ対応
Public Sub writeBitmap(filename As String, data() As Byte, width As Long, height As Long)
If width Mod 4 <> 0 Then Exit Sub '1ラインのデータ長(byte単位)が4の倍数でないとダメ
bfHeader.bfType = "BM"
bfHeader.bfSize = width * height * 3 + 54
bfHeader.bfReserved1 = 0
bfHeader.bfReserved2 = 0
bfHeader.bfOffBits = 54
biHeader.biSize = 40
biHeader.biWidth = width
biHeader.biHeight = height
biHeader.biPlanes = 1
biHeader.biBitCount = 24
biHeader.biCompression = 0
biHeader.biSizeImage = width * height * 3
biHeader.biXPixPerMeter = 0
biHeader.biYPixPerMeter = 0
biHeader.biClrUsed = 0
biHeader.biClrImportant = 0
Open filename For Binary As 1
Put 1, , bfHeader
Put 1, , biHeader
Put 1, , data
Close 1
End Sub
'Bitmapファイルの読み込み
'24bitフルカラーのみ対応
Public Sub readBitmap(filename As String, ByRef data() As Byte, ByRef width As Long, ByRef height As Long)
On Error GoTo Label1
Open filename For Binary As 1
Get 1, , bfHeader
If bfHeader.bfType <> "BM" Then GoTo Label1
Get 1, , biHeader
If biHeader.biSize <> 40 Then GoTo Label1
If biHeader.biBitCount <> 24 Then GoTo Label1
ReDim data(bfHeader.bfSize - bfHeader.bfOffBits) As Byte
Get 1, , data
width = biHeader.biWidth
height = biHeader.biHeight
Close 1
Exit Sub
Label1:
Close 1
MsgBox "error", vbExclamation
End Sub
********************************************************************************
Excel VBAでBitmapファイルを操作するモジュールを作ってみました。各ピクセルに適当な色を設定して、Bitmapファイルに保存する、みたいなことができます。
ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。
Bitmapファイルの詳細についてはWikipedia等を参照ください。
2016/1/4
変数を構造体に変更しました。わざわざ構造体にしなくてもいいんですが、気分です。
********************************************************************************
Option Explicit
'--------------------------------------------------
'Bitmapファイルの構造
'<BITMAPFILEHEADER構造体> + <BITMAPINFOHEADER構造体> + <カラーパレット> + <画像データ>
'--------------------------------------------------
'<BITMAPFILEHEADER構造体>
'bfType 2bytes "BM"
'bfSize 4bytes ファイルサイズ, byte単位
'bfReserved1 2bytes 予約領域
'bfReserved2 2bytes 予約領域
'bfOffBits 4bytes ファイル先頭から画像データまでのオフセット, byte単位
'--------------------------------------------------
'<BITMAPINFOHEADER構造体>
'biSize 4bytes BITMAPINFOHEADERのサイズ
'biWidth 4bytes 画像の幅, pixel単位
'biHeight 4bytes 画像の高さ, pixel単位
'biPlanes 2bytes プレーン数, 常に1
'biBitCount 2bytes 1画素当たりのデータサイズ, 1,4,8,24,32bitのいずれか
'biCompression 4bytes 圧縮形式, 無圧縮なら0
'biSizeImage 4bytes 画像データ部のサイズ, 0でもOK
'biXPixPerMeter 4bytes 横方向解像度, 1m当たりの画素数, 0でもOK
'biYPixPerMeter 4bytes 縦方向解像度, 1m当たりの画素数, 0でもOK
'biClrUsed 4bytes 格納されているパレット数, 0でもOK
'biClrImportant 4bytes 重要なパレットのインデックス, 0でもOK
'--------------------------------------------------
'<カラーパレット>
'1, 4, 8bitカラーの場合はカラーパレットのRGB値
'24, 32bitカラーの場合はない
'--------------------------------------------------
'<画像データ>
'1, 4, 8bitカラーの場合は、カラーパレットの値
'24, 32bitカラーの場合は、RGB値の配列
'画像の1ラインのデータ長は4の倍数byteじゃないとダメ (biWidth * biBitCount / 8 が 4の倍数)
'--------------------------------------------------
'<BITMAPFILEHEADER構造体>
Private Type BITMAP_FILE_HEADER
bfType As String * 2
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Private bfHeader As BITMAP_FILE_HEADER
'<BITMAPINFOHEADER構造体>
Private Type BITMAP_INFO_HEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPixPerMeter As Long
biYPixPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Private biHeader As BITMAP_INFO_HEADER
Public Sub test()
Dim i As Long
Dim j As Long
Dim width As Long
Dim height As Long
Dim pos As Long
Dim data() As Byte
Dim filename As String
'------------------------------
'データの作成
width = 256
height = 128
ReDim data(width * height * 3 - 1) As Byte
For i = 0 To height - 1
For j = 0 To width - 1
pos = (width * i + j) * 3
data(pos + 0) = CByte(255) 'Blue
data(pos + 1) = CByte(255 / height * i) 'Green
data(pos + 2) = CByte(255 / width * j) 'Red
Next j
Next i
'------------------------------
filename = ThisWorkbook.Path + "\test.bmp"
'ファイルに書き出す
writeBitmap filename, data, width, height
'ファイルから読み込む
readBitmap filename, data, width, height
End Sub
'Bitmapファイルの書き出し
'24bitフルカラーのみ対応
Public Sub writeBitmap(filename As String, data() As Byte, width As Long, height As Long)
If width Mod 4 <> 0 Then Exit Sub '1ラインのデータ長(byte単位)が4の倍数でないとダメ
bfHeader.bfType = "BM"
bfHeader.bfSize = width * height * 3 + 54
bfHeader.bfReserved1 = 0
bfHeader.bfReserved2 = 0
bfHeader.bfOffBits = 54
biHeader.biSize = 40
biHeader.biWidth = width
biHeader.biHeight = height
biHeader.biPlanes = 1
biHeader.biBitCount = 24
biHeader.biCompression = 0
biHeader.biSizeImage = width * height * 3
biHeader.biXPixPerMeter = 0
biHeader.biYPixPerMeter = 0
biHeader.biClrUsed = 0
biHeader.biClrImportant = 0
Open filename For Binary As 1
Put 1, , bfHeader
Put 1, , biHeader
Put 1, , data
Close 1
End Sub
'Bitmapファイルの読み込み
'24bitフルカラーのみ対応
Public Sub readBitmap(filename As String, ByRef data() As Byte, ByRef width As Long, ByRef height As Long)
On Error GoTo Label1
Open filename For Binary As 1
Get 1, , bfHeader
If bfHeader.bfType <> "BM" Then GoTo Label1
Get 1, , biHeader
If biHeader.biSize <> 40 Then GoTo Label1
If biHeader.biBitCount <> 24 Then GoTo Label1
ReDim data(bfHeader.bfSize - bfHeader.bfOffBits) As Byte
Get 1, , data
width = biHeader.biWidth
height = biHeader.biHeight
Close 1
Exit Sub
Label1:
Close 1
MsgBox "error", vbExclamation
End Sub
********************************************************************************
ExcelでDump
バイナリファイルをダンプしたい、ってことありますよね(?)
Excel VBAでDumperを作ってみました。
ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。
セキュリティの関係上、マクロのダウンロードは推奨されないですが、こちらにファイルをアップロードしておきます。
興味ある方は、ご自由にご利用ください。
--------------------------------------------------
Option Explicit
Public Sub test()
Dim filename As String
filename = Application.GetOpenFilename
'filename = ThisWorkbook.Path + "\test.bmp"
'filename = ThisWorkbook.Path + "\test.wav"
'filename = ThisWorkbook.Path + "\test.mid"
dump filename, 0
End Sub
'ファイルのダンプ
Private Sub dump(filename As String, offset As Long)
Dim i As Long
Dim j As Long
Dim size As Long
Dim buf() As Byte
size = 256 '読み込むデータサイズ
ReDim buf(size - 1) As Byte
Open filename For Binary As 1
'オフセット
For i = 0 To offset - 1
Get 1, , buf(0)
Next i
'Seek関数を使うなら、
'Seek 1, offset + 1
'データの読み込み
Get 1, , buf
Close 1
'データの表示
For i = 0 To 15
For j = 0 To 15
'10進数表示
'Sheet1.Cells(i + 1, j + 1) = buf(i * 16 + j)
'16進数表示
Sheet1.Cells(i + 1, j + 1) = Hex(buf(i * 16 + j))
'文字列表示
'Sheet1.Cells(i + 1, j + 1) = Chr(buf(i * 16 + j))
Next j
Next i
End Sub
Excel VBAでDumperを作ってみました。
ソースコードを以下に載せます。VBAのモジュールにコピペすれば使えるはずです。
セキュリティの関係上、マクロのダウンロードは推奨されないですが、こちらにファイルをアップロードしておきます。
興味ある方は、ご自由にご利用ください。
Option Explicit
Public Sub test()
Dim filename As String
filename = Application.GetOpenFilename
'filename = ThisWorkbook.Path + "\test.bmp"
'filename = ThisWorkbook.Path + "\test.wav"
'filename = ThisWorkbook.Path + "\test.mid"
dump filename, 0
End Sub
'ファイルのダンプ
Private Sub dump(filename As String, offset As Long)
Dim i As Long
Dim j As Long
Dim size As Long
Dim buf() As Byte
size = 256 '読み込むデータサイズ
ReDim buf(size - 1) As Byte
Open filename For Binary As 1
'オフセット
For i = 0 To offset - 1
Get 1, , buf(0)
Next i
'Seek関数を使うなら、
'Seek 1, offset + 1
'データの読み込み
Get 1, , buf
Close 1
'データの表示
For i = 0 To 15
For j = 0 To 15
'10進数表示
'Sheet1.Cells(i + 1, j + 1) = buf(i * 16 + j)
'16進数表示
Sheet1.Cells(i + 1, j + 1) = Hex(buf(i * 16 + j))
'文字列表示
'Sheet1.Cells(i + 1, j + 1) = Chr(buf(i * 16 + j))
Next j
Next i
End Sub
2015年1月10日土曜日
先生のジレンマ
2011/4/17に書いたコラムです。
--------------------------------------------------
先生とは人にものを教える素敵な仕事です。 学校の先生に限らず、職場の先輩なども教える側という意味では先生です。 私もいつかは人に教えられるようになりたいと思っています。 そんな先生ですが、時に先生という立場がかかえるジレンマがあると思います。
先生だって知らないことはあります。 先生だって間違うことがあります。 そんなときでも、「自分は先生だから教えなければならない」という過剰な義務感を持ってしまう先生がいます。 別に「知らなかった」「間違えた」「ごめんなさい」で問題ないのですが、自分が教えなければならないと思い込んでいる先生は、自身の間違いを認めなかったりします。 それでは先生失格です。
自分の経験に自信があって、生徒にそれを教えようなんて考えていてる先生が、自分の間違いを認めない…、ありそうな状況ではないでしょうか? ｢俺はこうやって来たんだ。」「これが正しいんだよ。」「教えるのは俺なんだ。」みたいな。
教えられている生徒が優秀だとさらに問題です。 生徒が間違いを指摘したとき、分かってくれる先生ならいいですが、 自分が教えなければならないと思い込んで、意固地になってしまう先生だと手のつけようがありません。 間違ったことを教えられる生徒はものすごいストレスです。
「先生という立場だから常に教えなければならない」ということはありません。知らないことは知らないと言う、間違えたら訂正する、私はそんな先生が良いと思います。
最後に論語の一節を引用しておきます。
「これを知るをこれを知ると為し、知らざるを知らずと為す。是れ知る為り。」
--------------------------------------------------
先生とは人にものを教える素敵な仕事です。 学校の先生に限らず、職場の先輩なども教える側という意味では先生です。 私もいつかは人に教えられるようになりたいと思っています。 そんな先生ですが、時に先生という立場がかかえるジレンマがあると思います。
先生だって知らないことはあります。 先生だって間違うことがあります。 そんなときでも、「自分は先生だから教えなければならない」という過剰な義務感を持ってしまう先生がいます。 別に「知らなかった」「間違えた」「ごめんなさい」で問題ないのですが、自分が教えなければならないと思い込んでいる先生は、自身の間違いを認めなかったりします。 それでは先生失格です。
自分の経験に自信があって、生徒にそれを教えようなんて考えていてる先生が、自分の間違いを認めない…、ありそうな状況ではないでしょうか? ｢俺はこうやって来たんだ。」「これが正しいんだよ。」「教えるのは俺なんだ。」みたいな。
教えられている生徒が優秀だとさらに問題です。 生徒が間違いを指摘したとき、分かってくれる先生ならいいですが、 自分が教えなければならないと思い込んで、意固地になってしまう先生だと手のつけようがありません。 間違ったことを教えられる生徒はものすごいストレスです。
「先生という立場だから常に教えなければならない」ということはありません。知らないことは知らないと言う、間違えたら訂正する、私はそんな先生が良いと思います。
最後に論語の一節を引用しておきます。
「これを知るをこれを知ると為し、知らざるを知らずと為す。是れ知る為り。」
2015年1月4日日曜日
相手の期待を考える
「相手の期待を考える」というのは、私が社会人1年目の研修で、講師の方がおっしゃっていた言葉です。いい言葉だと思ったので、今でも覚えています。
相手というのは、同僚や上司であったり、お客様であったり、その時々で変わります。自分が上司の立場だとすると、部下にはどのように動いて欲しいと思っているか？自分が客の立場だとすると、どのようなリクエストをするか？そのように相手の立場で考えてみると、客観的な思考ができます。
以心伝心とか阿吽の呼吸なんて言葉がありますが、これも相手の期待を考えるからできることです。相手の期待を先回りして考えることで、相手からの言葉を待たずに、スムースに物事が進められます。言葉を使っていなくても、これはコミュニケーションの重要な要素です。
もちろん、相手の本当の期待とは違った、ということがあるかもしれませんが、その時は修正すればいいだけです。相手のことを考えているという意思表示だけでも十分な意義があります。
まぁ、世の中、往々にして自分が期待していたようには、周りは動いてくれないものですが。
相手というのは、同僚や上司であったり、お客様であったり、その時々で変わります。自分が上司の立場だとすると、部下にはどのように動いて欲しいと思っているか？自分が客の立場だとすると、どのようなリクエストをするか？そのように相手の立場で考えてみると、客観的な思考ができます。
以心伝心とか阿吽の呼吸なんて言葉がありますが、これも相手の期待を考えるからできることです。相手の期待を先回りして考えることで、相手からの言葉を待たずに、スムースに物事が進められます。言葉を使っていなくても、これはコミュニケーションの重要な要素です。
もちろん、相手の本当の期待とは違った、ということがあるかもしれませんが、その時は修正すればいいだけです。相手のことを考えているという意思表示だけでも十分な意義があります。
まぁ、世の中、往々にして自分が期待していたようには、周りは動いてくれないものですが。
登録:
投稿 (Atom)