Главная » Delphi » Мультимедия » midi

midi

16:04
unit main;
 
interface
 
uses
Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
const
PPQN = 96;
Dur16th = PPQN div 4;
NoteOn = $99;
NoteOff = $89;
Velocity = 96 shl 16;
VelocityMax = 127 shl 16;
BassDrum = 35 shl 8;
ClosedHiHat = 42 shl 8;
Snare = 38 shl 8;
BassNoteOn = Velocity + BassDrum + NoteOn;
BassNoteOff = Velocity + BassDrum + NoteOff;
HiHatOn = Velocity + ClosedHiHat + NoteOn;
HiHatOff = Velocity + ClosedHiHat + NoteOff;
SnareOn = Velocity + Snare + NoteOn;
SnareOff = Velocity + Snare + NoteOff;
BassMaxOn = VelocityMax + BassDrum + NoteOn;
HiHatMaxOn = VelocityMax + ClosedHiHat + NoteOn;
SnareMaxOn = VelocityMax + Snare + NoteOn;
DummyNoteOn = $4090;
DummyNoteOff = $4080;
 
type
TMIDIEvent = record
dwDeltaTime: DWORD;
dwStreamID: DWORD;
dwEvent: DWORD;
end;
 
TDrumEvent = record
lpData: pointer;
size: Cardinal;
end;
 
const
Drum1: array [0..3] of TMIDIEvent =
(
(dwDeltaTime: 0; dwStreamID: 0; dwEvent: BassNoteOn),
(dwDeltaTime: 0; dwStreamID: 0; dwEvent: HiHatOn),
(dwDeltaTime: Dur16th; dwStreamID: 0; dwEvent: BassNoteOff),
(dwDeltaTime: Dur16th; dwStreamID: 0; dwEvent: HiHatOff)
);
 
Drum2: array [0..1] of TMIDIEvent =
(
(dwDeltaTime: 0; dwStreamID: 0; dwEvent: HiHatOn),
(dwDeltaTime: Dur16th; dwStreamID: 0; dwEvent: HiHatOff)
);
 
Drum3: array [0..5] of TMIDIEvent =
(
(dwDeltaTime: 0; dwStreamID: 0; dwEvent: BassMaxOn),
(dwDeltaTime: 0; dwStreamID: 0; dwEvent: HiHatMaxOn),
(dwDeltaTime: 0; dwStreamID: 0; dwEvent: SnareMaxOn),
(dwDeltaTime: Dur16th; dwStreamID: 0; dwEvent: BassNoteOff),
(dwDeltaTime: Dur16th; dwStreamID: 0; dwEvent: HiHatOff),
(dwDeltaTime: Dur16th; dwStreamID: 0; dwEvent: SnareOff)
);
 
DrumNOPDummy: array [0..1] of TMIDIEvent =
(
(dwDeltaTime: 0; dwStreamID: 0; dwEvent: DummyNoteOn),
(dwDeltaTime: Dur16th; dwStreamID: 0; dwEvent:
DummyNoteOff)
);
 
DrumNOP: TMIDIEvent =
(
dwDeltaTime: Dur16th; dwStreamID: 0; dwEvent: MEVT_NOP
shl 24
);
 
DrumTable: array [1..16] of TDrumEvent =
(
(lpData: @Drum1; size: sizeof(Drum1)),
(lpData: @DrumNOP; size: sizeof(DrumNOP)),
(lpData: @Drum2; size: sizeof(Drum2)),
(lpData: @DrumNOP; size: sizeof(DrumNOP)),
(lpData: @Drum3; size: sizeof(Drum1)),
(lpData: @DrumNOP; size: sizeof(DrumNOP)),
(lpData: @Drum2; size: sizeof(Drum2)),
(lpData: @DrumNOP; size: sizeof(DrumNOP)),
(lpData: @Drum1; size: sizeof(Drum1)),
(lpData: @DrumNOP; size: sizeof(DrumNOP)),
(lpData: @Drum2; size: sizeof(Drum2)),
(lpData: @DrumNOP; size: sizeof(DrumNOP)),
(lpData: @Drum3; size: sizeof(Drum1)),
(lpData: @DrumNOP; size: sizeof(DrumNOP)),
(lpData: @Drum2; size: sizeof(Drum2)),
(lpData: @DrumNOP; size: sizeof(DrumNOP))
);
 
type
TMainForm = class(TForm)
PlayBtn: TButton;
StopBtn: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PlayBtnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
private
{ Private declarations }
procedure MOMDONE(var msg: TMessage); message MM_MOM_DONE;
public
{ Public declarations }
stream: HMIDISTRM;
header: TMIDIHDR;
note: integer;
end;
 
var
MainForm: TMainForm;
 
implementation
 
{$R *.DFM}
 
procedure Check(status: MMResult);
begin
if status <> MMSYSERR_NOERROR then
MessageDlg('MIDI Stream error: ' + IntToStr(status), mtError, [mbOK], 0);
end;
 
procedure TMainForm.MOMDONE(var msg: TMessage);
begin
Check(midiOutUnprepareHeader(stream, @header, sizeof(TMIDIHDR)));
header.lpData := DrumTable[note].lpData;
header.dwBufferLength := DrumTable[note].size;
header.dwBytesRecorded := DrumTable[note].size;
Check(midiOutPrepareHeader(stream, @header, sizeof(TMIDIHDR)));
Check(midiStreamOut(stream, @header, sizeof(TMIDIHDR)));
inc(note);
if note > 16 then note := 1;
end;
 
procedure TMainForm.FormCreate(Sender: TObject);
var
device: integer;
timediv: TMIDIPROPTIMEDIV;
tempo: TMIDIPROPTEMPO;
begin
device := 0;
Check(midiStreamOpen(@stream, @device, 1, Handle, 0, CALLBACK_WINDOW));
timediv.cbStruct := sizeof(TMIDIPROPTIMEDIV);
timediv.dwTimeDiv := PPQN;
Check(midiStreamProperty(stream, @timediv, MIDIPROP_SET or MIDIPROP_TIMEDIV));
tempo.cbStruct := sizeof(TMIDIPROPTEMPO);
tempo.dwTempo := $0007A120;
Check(midiStreamProperty(stream, @tempo, MIDIPROP_SET or MIDIPROP_TEMPO));
end;
 
procedure TMainForm.FormDestroy(Sender: TObject);
begin
Check(midiStreamClose(stream));
end;
 
procedure TMainForm.PlayBtnClick(Sender: TObject);
begin
note := 1;
header.lpData := DrumTable[note].lpData;
header.dwBufferLength := DrumTable[note].size;
header.dwBytesRecorded := DrumTable[note].size;
Check(midiOutPrepareHeader(stream, @header, sizeof(TMIDIHDR)));
Check(midiStreamOut(stream, @header, sizeof(TMIDIHDR)));
Check(midiStreamRestart(stream));
inc(note);
end;
 
procedure TMainForm.StopBtnClick(Sender: TObject);
begin
Check(midiStreamStop(stream));
Check(midiOutUnprepareHeader(stream, @header, sizeof(TMIDIHDR)));
end;
 
end.


main.dfm

object MainForm: TMainForm
Left = 193
Top = 114
Width = 378
Height = 147
Caption = 'MIDI Streaming sample'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poDefaultPosOnly
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object PlayBtn: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = '&Play'
TabOrder = 0
OnClick = PlayBtnClick
end
object StopBtn: TButton
Left = 112
Top = 8
Width = 75
Height = 25
Caption = '&Stop'
TabOrder = 1
OnClick = StopBtnClick
end
end