program onetrackmidigeneratorProject;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, onetrackmidigenerator
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
==============
unit onetrackmidigenerator;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
LCLIntf;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var strMididata: string;
var n : integer;
var myFile : TextFile;
var midinotes : array of integer;
var notelengths : array of integer;
begin
//Remember to close media player every time before generating the new file
//otherwise error rises, because the midi file is locked by the system
//Of course you can build an error handling for this ;)
AssignFile(myFile, 'mymidifile.mid');
ReWrite(myFile);
// HEADER CHUNK -----------------------------
strMididata := 'MThd'; //CHUNK id, it's always the same [4 bytes]
Write(myFile, strMididata);
//chunk-size: [4 bytes], value always 6
strMididata := chr($00) + chr($00) + chr($00) + chr($06);
Write(myFile, strMididata);
//midi-file format type = 0/1/2: [2 bytes]
//type 1 midi-file can use several tracks, type 0 only one track
strMididata := chr($00) + chr($00); // midi file type 0 in use
Write(myFile, strMididata);
//number of tracks = 1: [2 bytes]
strMididata := chr($00) + chr($01); // one track
Write(myFile, strMididata);
// Time division $60 = 96 ticks per 1/4 note: [2 bytes]
strMididata := chr($00) + chr(96);
Write(myFile, strMididata);
//TRACK HEADER ----------------------------------
strMididata := 'MTrk'; // Track header, always the same // [4 bytes]
Write(myFile, strMididata);
// Track CHUNK-SIZE: [4bytes]
strMididata := chr($00) + chr($00) + chr($00) + chr(46); // chunk size 46 bytes
Write(myFile, strMididata);
//Midi-play commands ---------------->
//Keep track of byte count and add the final value to the Chunk size value
//TEMPO [7 bytes]
//Delta time $00 one byte | Tempo-id (3 bytes): $FF $51 $03 | Tempo value 3 bytes (value in
// microseconds per MIDI quarter-note)
//120 bpm would be 500000 microseconds per quarter note :Hex 07 A1 20
//100 bpm would be 600000 microseconds per quarter note :Hex 09 27 C0
//60 bpm would be 1000000 microseconds per quarter note: Hex 0F 42 40
//50 bpm would be 1200000 microseconds per quarter note: Hex 12 4F 80
//30 bpm would be 2 000 000 microseconds per quarter note: Hex 1E 84 80
strMididata := chr($00) + chr($FF) + chr($51) + chr($03)+ chr($1E) + chr($84) + chr($80); // 30 bpm
Write(myFile, strMididata);
// Instrument change for the Channel 0: [3 bytes]
// delta time | instr change C+ch0 | GM instrument 10
strMididata := chr($00) + chr($C0)+ chr(10);
Write(myFile, strMididata);
//------------
SetLength (midinotes, 4);
midinotes[0] := 60;
midinotes[1] := 62;
midinotes[2] := 64;
midinotes[3] := 66;
SetLength (notelengths, 4);
notelengths[0] := 60;
notelengths[1] := 30;
notelengths[2] := 30;
notelengths[3] := 108;
//Let's have some MIDI notes
for n := 0 to 3 do // [4x8 = 32 bytes]
begin
//Note on: [4 bytes]
// delta | note on $9 +ch0 | midinote (0-127) | vol (0-127)
strMididata := chr($0) + chr($90) + chr(midinotes[n]) + chr(100);
Write(myFile, strMididata);
//Note off: [4 bytes]
// delta=note length | note off $8 + ch0 | midinote | vol
strMididata := chr(notelengths[n]) + chr($80) + chr(midinotes[n]) + chr(100);
Write(myFile, strMididata);
end;
//----------------
//Track end: delta(1 byte) + track end id (3 bytes): [4 bytes]
strMididata := chr($00) + chr($FF) + chr($2F)+ chr($00) ; //Always the same
Write(myFile, strMididata);
//=================
CloseFile(myFile);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
OpenDocument('mymidifile.mid');
//Works only in Windows...?
end;
end.