MIDIファイルを作成する(Delphi)
MIDIファイルを作成するサンプルプログラムですが、今回はMIDIファイルフォーマットの解説や64種類の鍵盤、128種類の楽器、和音(音を重ねる)、テンポ、音の強さ、休符、実際の楽譜からMIDIデータの作成、ドラム/ベースなどのリズムマップ音の利用などと内容が充実しています。Delphiがなくても実行ファイルを付属しているのでテストをする事が出来ます。
サンプルの画面
サンプルプログラムはDemo1とDemo2の2画面となります。


[Demo_1.pas]
//==============================================================================
//
// 「MIDI セーバー 第一弾 -簡単なMIDIファイルを作って見よう!!-」
//
//==============================================================================
// Version 1.1
//==============================================================================
//
// Version 1.0 初版完成 2001-03-30
// 1.1 2001-08-06
//
//==============================================================================
unit Demo_1;
{
序章
^^^^
<MIDIとは?>
MIDIとは「Musical Instrument Digital Interface」の頭文字をとったもので、
電子楽器の演奏情報をやり取りするための世界共通のデジタルインターフェイスの規格です。
また、現在のMIDIファイルというと一般的にSMFファイルのことをMIDIファイルと呼びます。
SMF(Standard MIDI File)のフォーマット
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
<最初に>
SMFファイルはバイナリ形式ファイルなので理解するには
「バイナリエディタ」があると非常に解かりやすいと思います。
<全体の構造>
SMFファイルは「ヘッダチャンク」と「トラックチャンク」に分類されます。
トラックチャンクには実際の演奏データとそれに付随する情報が格納されます。
また、トラックチャンクは複数存在する場合があります。「デモ2」プログラムではそのサンプルプログラムです。
<ヘッダチャンク(14byte)>
--------------------------
(1)チャンクタイプ (4byte)
--------------------------
(2)データ長 (4byte)
--------------------------
(3)フォーマット (2byte)
--------------------------
(4)トラック数 (2byte)
--------------------------
(5)時間単位 (2byte)
--------------------------
(1)チャンクタイプ
いわゆるマジックナンバーは常に'MThd'になる
(2)データ長
データ長は6バイトに固定(これから続くヘッダーサイズ)
(3)フォーマット
0,1,2の3種類ある
0 ---シングルトラック
1 ---マルチトラック
2 ---余り使われません。
(4)トラック数
このSMFに含まれるトラックチャンクの数を表します。
(5)時間単位
・小節/拍/クロック(ティック)でタイミングを表す形式
・絶対時間でタイミングを表す形式
の2種類あります。このサンプルでは後者を使っています。また、前者の方を質問されても私にはわかりませんのでご了承下さい。m(- -)m
※Delphiの構造体にすると下記のようになります。
Type (14byte)
TSMFHEDAER=packed record
ChunckType : Dword;
DataLength : Dword;
Format : Word ;
TrackCount : Word ;
TimeType : Word ;
end;
<トラックチャンク(8byte)+(データセクション )>
--------------------------
(1)チャンクタイプ (4byte)
--------------------------
(2)データ長 (4byte)
--------------------------
(1)チャンクタイプ
常に'MTrk'になる
(2)データ長
これから続くデータセクションの長さ
※Delphiの構造体にすると下記のようになります。
Type (8byte)
TSMFTRACKCHUNCK=packed record
ChunckType : Dword;
DataLength : Dword;
end;
※データセクション
データセクションでは時間情報を付加したイベントが順番に格納されます。
また、SMFでは「MIDIイベント」「SysExイベント」「メタイベント」の3種類のイベントがあります。
<MIDIイベント>
演奏データの実体ともいえるイベント
・ノートオンメッセージ(音を出す命令)
・ノートオフメッセージ(音を消す命令)
・プログラムチェンジメッセージ(音色を変更する命令)
<メタイベント>
著作権情報やコメントなどを記述するイベント
また、メタイベントは16進の「FF」から始まります。
<SysExイベント>
これはあまり気にしなくてもいいイベントです。(本当は使用したほうが良い(?)かもしれませんがサンプルでは使っていません)
※これ以外にもイベントは沢山あります。もっと詳しく知りたい方は書籍などをご覧下さい。
また、通常はこれだけで十分でがその他のソフトで作成されたMIDIファイルを読み込む場合は全てのイベントを知っていないと読み込むのは難しいです。(^^;
※バイトオーダーがインテルオーダー(順番逆転)の場合があるので注意して下さい。
<用語>
<MIDIチャンネル>
4ビットで表現できる0-15(0-F)の16種類の値をとることができることによってMIDIチャンネルは最大16チャンネルまで表現できます
<ノートオフメッセージ>
・音を止める
8n kk vv
n --- 「チャンネルナンバー」
MIDIチャンネル($0からFまで)
※リズム音はチャンネルナンバーが10番目になります。(GM規定)
kk --- 「ノートナンバー」
音程をあらわす(下記を参照)
vv --- 「ぺロシティ」
鍵盤を弾くときの速さ(音の強さ)を表す値
1~127の127段階
0はノートオフと同じ動作=音を消す
<ノートオンメッセージ>
・音を発音する
9n kk vv
n --- 「チャンネルナンバー」
MIDIチャンネル($0からFまで)
※リズム音はチャンネルナンバーが10番目になります。(GM規定)
kk --- 「ノートナンバー」
音程をあらわす(下記を参照)
vv --- 「ぺロシティ」
鍵盤を弾くときの速さ(音の強さ)を表す値
1~127の127段階
0はノートオフと同じ動作=音を消す
<プログラムメッセージ>
・楽器を選択
C0 pp
pp ---「プログラムナンバー」
楽器の種類「サウンド音色(128種類) 一覧表」を参照
----- 「メタイベント 一覧表」 -----
//テキスト情報を格納する
FF 01 len text
//著作権
FF 02 len text
//シーケンス名/トラック名
FF 03 len text
//楽器名
FF 04 len text
//歌詞
FF 05 len text
//エンドオブトラック(トラックの終了サイン)
FF 2F 00
※ここでは最低限必要と思われるものしか記述していません。
------ 「サウンド音色(128種類) 一覧表」-----
このサンプルのリストボックスを参照して下さい。
そのまま順番にはいっています。
------- 「リズム音色マップ 一覧表」 --------
No. 音色名
35 Acoustic Bass Drum
36 Bass Drum1
37 Side Stick
38 Acoustic Snare
39 Hand Clap
40 Electric Snare
41 Low Floor Tom
42 Closed Hi-Hat
43 High Floor Tom
44 Pedal Hi-Hat
45 Low Tom
46 Open Hi-Hat
47 Low-Mid Tom
48 Hi-Mid Tom
49 Crash Cymbal1
50 High Tom
51 Ride Cymbal1
52 Chinese Cymbal
53 Ride Bell
54 Tambourine
55 Splash Cymbal
56 Cowbell
57 Crash Cymbal2
58 Vibraslap
59 Ride Cymbal2
60 Hi Bongo
61 Low Bongo
62 Mute Hi Conga
63 Open Hi Conga
64 Low Conga
65 High Timbale
66 Low Timbale
67 High Agogo
68 Low Agogo
69 Cabasa
70 Maracas
71 Short Whistle
72 Long Whistle
73 Short Guiro
74 Long Guiro
75 Clavas
76 Hi Wood Block
77 Low Wood Block
78 Mute Cuica
79 Open Cuica
80 Mute Triangle
81 Open Triangle
------- 「ノートナンバー 一覧表」 --------
|| ド | ド# | レ | レ# | ミ |ファ |ファ#| ソ | ソ# | ラ | ラ# | シ
-------------------------------------------------------------------------
|| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11
|| 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23
|| 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35
|| 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47
--- このサンプルはこの間のみ使用-----------------------------------------------
|| 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59
|| 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71
|| 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83
-------------------------------------------------------------------------------
|| 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95
|| 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107
|| 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119
|| 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 |
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, MPlayer, ComCtrls ;
type
TForm1 = class(TForm)
Memo1: TMemo;
Panel1: TPanel;
Shape36: TShape;
Shape34: TShape;
Shape32: TShape;
Shape29: TShape;
Shape27: TShape;
Shape24: TShape;
Shape22: TShape;
Shape20: TShape;
Shape17: TShape;
Shape15: TShape;
Shape12: TShape;
Shape10: TShape;
Shape13: TShape;
Shape11: TShape;
Shape8: TShape;
Shape5: TShape;
Shape1: TShape;
Shape3: TShape;
Shape2: TShape;
Shape4: TShape;
Shape6: TShape;
Shape7: TShape;
Shape9: TShape;
Shape14: TShape;
Shape16: TShape;
Shape18: TShape;
Shape19: TShape;
Shape21: TShape;
Shape23: TShape;
Shape25: TShape;
Shape26: TShape;
Shape28: TShape;
Shape30: TShape;
Shape31: TShape;
Shape33: TShape;
Shape35: TShape;
ListBox1: TListBox;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
SaveDialog1: TSaveDialog;
Button2: TButton;
RadioButton4: TRadioButton;
RadioButton5: TRadioButton;
MediaPlayer1: TMediaPlayer;
Image1: TImage;
Label4: TLabel;
Label5: TLabel;
Edit1: TEdit;
Edit2: TEdit;
UpDown1: TUpDown;
Edit3: TEdit;
Label6: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape6MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape6MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape7MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape8MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape8MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape9MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape9MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape10MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape10MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape11MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape12MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape12MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape13MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape13MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape14MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape14MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape15MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape15MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape16MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape16MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape17MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape17MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape18MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape18MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape19MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape19MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape20MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape20MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape21MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape21MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape22MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape22MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape23MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape23MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape24MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape24MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape25MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape25MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape26MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape26MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape27MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape27MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape28MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape28MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape29MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape29MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape30MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape30MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape31MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape31MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape32MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape32MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape33MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape33MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape34MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape34MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape35MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape35MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape36MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Shape36MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button2Click(Sender: TObject);
procedure Memo1Change(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private 宣言 }
procedure WriteMIDIFile(Filename :String);
public
{ Public 宣言 }
end;
Type{14byte}
TSMFHEDAER=packed record
ChunckType : Dword; // SMFのID ・'MThd' $6468544D
DataLength : Dword; // データの長さ ・ここからの構造体の大きさ 常に$06000000
Format : Word ; // SMFフォーマットの種類 ・「0,1,2のどれか」 0---シングルトラック 1---マルチトラック 2---通常使わない
TrackCount : Word ; // トラック数 ・
TimeType : Word ; // 時間の種類 ・小節/拍/クロック(ティック)でタイミングを表す形式と絶対時間でタイミングを表す形式がある
end;
Type {8byte}
TSMFTRACKCHUNCK=packed record
ChunckType : Dword; // トラックチャンクのID ・ 'MTrk'($6B72544D)
DataLength : Dword; // これ以後のデータの長さ ・
end;
//著作権情報とソフトウェア情報を変更したい場合はこの配列及び値を変更して下さい。(ソフトウェア情報は入れないほうがいいかも?)
Var
SoftWare : array[0..20] of char = ('C','r','e','a','t','e','d',' ','b','y',
' ','M','I','D','I',' ','S','a','v','e',
'r') ;
Copyright : array[0..13]of char = ('T','a','r','o',' ','Y','a','m','a','d',
'a','?','?','?') ;
var
Form1: TForm1;
implementation
{$R *.DFM}
//プロシージャ&ファンクション---------------------------------------------------
//////// インテルオーダー word編
function IntelOder_word(Buffer :word):word;
begin
Result :=(Buffer AND $00FF) shl 8 ;
Result :=Result+(Buffer AND $FF00) shr 8 ;
end;
//////// インテルオーダー Dword編
function IntelOder_Dword(Buffer :Dword):Dword;
begin
Result :=(Buffer AND $000000FF) shl 24 ;
Result :=Result or ((Buffer AND $0000FF00) shl 8) ;
Result :=Result or ((Buffer AND $00FF0000) shr 8) ;
Result :=Result or ((Buffer AND $FF000000) shr 24) ;
end;
///////// MIDIファイル作成
procedure TForm1.WriteMIDIFile(Filename :String);
Var
MemoryStream : TMemoryStream ;
SMFHEDAER : TSMFHEDAER ; //SMFヘッダー
SMFTRACKCHUNCK : TSMFTRACKCHUNCK ; //SMFトラックチャンク
Instrument : Word ; //楽器
Versity : Byte ; //べロシティ(音の強さ)
NoteNumber : Byte ; //ノートナンバー(音階)
DataSize : integer ; //データのサイズ
_Zero : byte; //ゼロ
_Max : byte; //マックス
_End : word; //終了値
_NoteOn : byte; //ノートオン
_NoteOff : byte; //ノートオフ
_SetTemp : byte; //テンポ
_Copyright : byte; //著作権
_Copyright_Len : byte; //著作権情報の文字数
_SoftWare : byte; //ソフトウェア
_SoftWare_Len : byte; //ソフトウェアの文字数
i ,Count : integer ;
Buffer : string ;
begin
//初期化
FillChar(SMFHEDAER,Sizeof(TSMFHEDAER),0);
FillChar(SMFTRACKCHUNCK,Sizeof(TSMFTRACKCHUNCK),0);
MemoryStream :=TMemoryStream.Create;
_Zero :=$00; //ゼロ
_Max :=$FF; //マックス
_End :=$002F; //終了値
_NoteOn :=$90; //ノートオン
_NoteOff :=$80; //ノートオフ
_Copyright :=$02; //著作権
_SoftWare :=$01; //ソフトウェア
//SMFヘッダーの準備
SMFHEDAER.ChunckType :=$6468544D; //SMFのID
SMFHEDAER.DataLength :=IntelOder_DWord(6); //データの長さ
SMFHEDAER.Format :=IntelOder_Word(1); //フォーマット
SMFHEDAER.TrackCount :=IntelOder_Word(1); //トラック数
SMFHEDAER.TimeType :=$1000; //時間単位
//テンポの計算
//0.125秒(16分音符)
if RadioButton1.Checked then _SetTemp :=$04;
//0.25秒(8分音符)
if RadioButton2.Checked then _SetTemp :=$08;
//0.5秒(4分音符)
if RadioButton3.Checked then _SetTemp :=$10;
//1秒(2分音符)
if RadioButton4.Checked then _SetTemp :=$20;
//2秒(全音符)
if RadioButton5.Checked then _SetTemp :=$40;
//SMFチャンク準備
SMFTRACKCHUNCK.ChunckType := $6B72544D; //SMFトラックチャンクのID
SMFTRACKCHUNCK.DataLength := 0 ; //これ以後のデータの長さ
//楽器の選択
Instrument :=$C0 + (ListBox1.ItemIndex * $100) ;
//音の強さ
Versity :=STrtoint(Edit3.Text);
//サイズを取得しておく
_SoftWare_Len :=Sizeof(SoftWare);
_Copyright_Len :=Sizeof(Copyright);
//文字数を取得
Count :=Length(Memo1.Text);
BUffer :=Memo1.text;
//書き込み------------------------------------------
//GetMem(動的メモリ)を使用して保存した方が高速です。
try
//SMFヘッダーの書き込み
MemoryStream.Write(SMFHEDAER,Sizeof(TSMFHEDAER));
//トラックチャンクの書き込み
MemoryStream.Write(SMFTRACKCHUNCK,Sizeof(SMFTRACKCHUNCK));
//著作権情報
MemoryStream.Write(_Zero,1);
MemoryStream.Write(_MAX,1);
MemoryStream.Write(_Copyright,1);
MemoryStream.Write(_Copyright_Len,1);
MemoryStream.Write(Copyright,_Copyright_Len);
//ソフトウェア情報
MemoryStream.Write(_Zero,1);
MemoryStream.Write(_MAX,1);
MemoryStream.Write(_SoftWare,1);
MemoryStream.Write(_SoftWare_Len,1);
MemoryStream.Write(software,_SoftWare_Len);
//楽器の書き込み
MemoryStream.Write(_Zero,1);
MemoryStream.Write(Instrument,2);
MemoryStream.Write(_Zero,1);
//音色を書き出す
For i := 0 to Round(Count /2)-1 do
begin
NoteNumber :=Strtoint('$'+Copy(Buffer,0,2));
Delete(BUffer,1,2);
//ノートオンメッセージの書き込み
MemoryStream.Write(_NoteOn,1);
MemoryStream.Write(NoteNumber,1);
MemoryStream.Write(Versity,1);
MemoryStream.Write(_SetTemp,1);
//ノートオフメッセージの書き込み
MemoryStream.Write(_Noteoff,1);
MemoryStream.Write(NoteNumber,1);
MemoryStream.Write(Versity,1);
//最後でなかったら
if i<>Round(Count /2)-1 then
MemoryStream.Write(_Zero,1)
else
MemoryStream.Write(_SetTemp,1) ;
end;
//データの終了サインを書き込む
MemoryStream.Write(_Max,1);
MemoryStream.Write(_End,2);
//トラックチャンクにデータの長さを書き込む
DataSize := MemoryStream.Size-22;
MemoryStream.Position :=18;
DataSize :=IntelOder_Dword(DataSize) ;
MemoryStream.Write(DataSize,4);
DeleteFile(Filename) ;
MemoryStream.SavetoFile(Filename);
finally
MemoryStream.FRee;
end;
end;
////////////////////////////////////////////////////////////////////////////////
/////////
procedure TForm1.Button1Click(Sender: TObject);
begin
if Savedialog1.Execute then
begin
if AnsiCompareText('.mid',ExtractFileext(SaveDialog1.Filename))<>0 then
SaveDialog1.Filename :=SaveDialog1.Filename+'.mid';
try
WriteMIDIFile(SaveDialog1.Filename);
except
end;
end;
end;
/////////
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.text :='';
Button1.Enabled :=false;
end;
/////////
procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.ItemIndex:=0;
try
Image1.picture.bitmap.Loadfromfile(ExtractFilePath(Application.Exename)+'Demo1_1.bmp');
except
end;
end;
/////////
procedure TForm1.Memo1Change(Sender: TObject);
begin
if Memo1.Text='' then
begin
Button1.Enabled :=false;
Exit;
end;
MediaPlayer1.Close;
Button1.Enabled :=true;
WriteMIDIFile(ExtractFilePath(Application.Exename)+'消さないで!.mid');
MediaPlayer1.FileName:=ExtractFilePath(Application.Exename)+'消さないで!.mid';
MediaPlayer1.Open;
end;
/////////
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DeleteFile(ExtractFilePath(Application.Exename)+'消さないで!.mid') ;
end;
////鍵盤操作--------------------------------------------------------------------
procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape1.Brush.Color :=clRed;
end;
procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape1.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'30';
end;
end;
procedure TForm1.Shape2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape2.Brush.Color :=clred;
end;
procedure TForm1.Shape2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape2.Brush.Color :=clBlack;
Memo1.Text :=Memo1.Text +'31';
end;
end;
procedure TForm1.Shape3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape3.Brush.Color :=clred;
end;
procedure TForm1.Shape3MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape3.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'32';
end;
end;
procedure TForm1.Shape4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape4.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'33';
end;
end;
procedure TForm1.Shape4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape4.Brush.Color :=clred;
end;
procedure TForm1.Shape5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape5.Brush.Color :=clred;
end;
procedure TForm1.Shape5MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape5.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'34';
end;
end;
procedure TForm1.Shape6MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape6.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'35';
end;
end;
procedure TForm1.Shape6MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape6.Brush.Color :=clred;
end;
procedure TForm1.Shape7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape7.Brush.Color :=clred;
end;
procedure TForm1.Shape7MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape7.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'36';
end;
end;
procedure TForm1.Shape8MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape8.Brush.Color :=clred;
end;
procedure TForm1.Shape8MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape8.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'37';
end;
end;
procedure TForm1.Shape9MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape9.Brush.Color :=clred;
end;
procedure TForm1.Shape9MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape9.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'38';
end;
end;
procedure TForm1.Shape10MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape10.Brush.Color :=clred;
end;
procedure TForm1.Shape10MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape10.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'39';
end;
end;
procedure TForm1.Shape11MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape11.Brush.Color :=clred;
end;
procedure TForm1.Shape11MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape11.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'3A';
end;
end;
procedure TForm1.Shape12MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape12.Brush.Color :=clred;
end;
procedure TForm1.Shape12MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape12.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'3B';
end;
end;
procedure TForm1.Shape13MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape13.Brush.Color :=clred;
end;
procedure TForm1.Shape13MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape13.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'3C';
end;
end;
procedure TForm1.Shape14MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape14.Brush.Color :=clred;
end;
procedure TForm1.Shape14MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape14.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'3D';
end;
end;
procedure TForm1.Shape15MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape15.Brush.Color :=clred;
end;
procedure TForm1.Shape15MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape15.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'3E';
end;
end;
procedure TForm1.Shape16MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape16.Brush.Color :=clred;
end;
procedure TForm1.Shape16MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape16.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'3F';
end;
end;
procedure TForm1.Shape17MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape17.Brush.Color :=clred;
end;
procedure TForm1.Shape17MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape17.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'40';
end;
end;
procedure TForm1.Shape18MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape18.Brush.Color :=clred;
end;
procedure TForm1.Shape18MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape18.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'41';
end;
end;
procedure TForm1.Shape19MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape19.Brush.Color :=clred;
end;
procedure TForm1.Shape19MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape19.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'42';
end;
end;
procedure TForm1.Shape20MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape20.Brush.Color :=clred;
end;
procedure TForm1.Shape20MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape20.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'43';
end;
end;
procedure TForm1.Shape21MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape21.Brush.Color :=clred;
end;
procedure TForm1.Shape21MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape21.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'44';
end;
end;
procedure TForm1.Shape22MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape22.Brush.Color :=clred;
end;
procedure TForm1.Shape22MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape22.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'45';
end;
end;
procedure TForm1.Shape23MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape23.Brush.Color :=clred;
end;
procedure TForm1.Shape23MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape23.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'46';
end;
end;
procedure TForm1.Shape24MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape24.Brush.Color :=clred;
end;
procedure TForm1.Shape24MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape24.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'47';
end;
end;
procedure TForm1.Shape25MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape25.Brush.Color :=clred;
end;
procedure TForm1.Shape25MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape25.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'48';
end;
end;
procedure TForm1.Shape26MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape26.Brush.Color :=clred;
end;
procedure TForm1.Shape26MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape26.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'49';
end;
end;
procedure TForm1.Shape27MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape27.Brush.Color :=clred;
;
end;
procedure TForm1.Shape27MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape27.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'4A';
end;
end;
procedure TForm1.Shape28MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape28.Brush.Color :=clred;
end;
procedure TForm1.Shape28MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape28.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'4B';
end;
end;
procedure TForm1.Shape29MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape29.Brush.Color :=clred;
end;
procedure TForm1.Shape29MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape29.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'4C';
end;
end;
procedure TForm1.Shape30MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape30.Brush.Color :=clred;
end;
procedure TForm1.Shape30MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape30.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'4D';
end;
end;
procedure TForm1.Shape31MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape31.Brush.Color :=clred;
end;
procedure TForm1.Shape31MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape31.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'4E';
end;
end;
procedure TForm1.Shape32MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape32.Brush.Color :=clred;
end;
procedure TForm1.Shape32MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape32.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'4F';
end;
end;
procedure TForm1.Shape33MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape33.Brush.Color :=clred;
end;
procedure TForm1.Shape33MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape33.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'50';
end;
end;
procedure TForm1.Shape34MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape34.Brush.Color :=clred;
end;
procedure TForm1.Shape34MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape34.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'51';
end;
end;
procedure TForm1.Shape35MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape35.Brush.Color :=clred;
end;
procedure TForm1.Shape35MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape35.Brush.Color :=clblack;
Memo1.Text :=Memo1.Text +'52';
end;
end;
procedure TForm1.Shape36MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then Shape36.Brush.Color :=clred;
end;
procedure TForm1.Shape36MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button= mbLeft then
begin
Shape36.Brush.Color :=clwhite;
Memo1.Text :=Memo1.Text +'53';
end;
end;
end.
サンプルプログラム一式のダウンロード
create_midi_delphi.zip 432 KB (443,294 バイト)
注意事項
このサンプルは約15年前に作成した「いにしえ」の産物です。予めご了承下さい。
スポンサーリンク
関連記事
公開日:2015年02月19日
記事NO:00246
プチモンテ ※この記事を書いた人
![]() | |
![]() | 💻 ITスキル・経験 サーバー構築からWebアプリケーション開発。IoTをはじめとする電子工作、ロボット、人工知能やスマホ/OSアプリまで分野問わず経験。 画像処理/音声処理/アニメーション、3Dゲーム、会計ソフト、PDF作成/編集、逆アセンブラ、EXE/DLLファイルの書き換えなどのアプリを公開。詳しくは自己紹介へ |
| 🎵 音楽制作 BGMは楽器(音源)さえあれば、何でも制作可能。歌モノは主にロック、バラード、ポップスを制作。歌詞は抒情詩、抒情的な楽曲が多い。楽曲制作は🔰2023年12月中旬 ~ | |









