Главная » 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