midigen.pas

TMidiGen is a MIDI component by Alan Warriner which allows the simple creation of sound effects and

begin
passed:=TMidiGen(inst);

//pass to wndproc
PostMessage(passed.TMGHwnd,msg,0,0);

end;

//play string
//----------------------------------------------------------------------------
function TMidiGen.PlayString(Notes:String):bool;
var
   Data:TList;
   CanUsePB:bool;

begin
Result:=false;

//no play allowed?
if not WaitForClose then exit;

LoopCount:=fLoops;
ChannelInUse:=fChannel;

Data:=TList.Create;

CanUsePB:=ExtractNotes(Notes,Data);

if Data.Count>0 then
   Result:=PlayData(false,CanUSePB,Data);

Data.Free;
Data:=nil;

end;
//play single from properties
//----------------------------------------------------------------------------
function TMidiGen.Play:bool;
begin
Result:=PlayNote(Integer(fNote)+(12*fOctave));
end;

//play single
//----------------------------------------------------------------------------
function TMidiGen.PlayNote(NoteVal:Integer):bool;
var
   Data:TList;
   info:^event;
   tChannel:TMGChannel;
   tNote:Integer;

begin
result:=false;

if not WaitForClose then exit;

LoopCount:=fLoops;
ChannelInUse:=fChannel;

Data:=TList.Create;

//add instrument
if ChannelInUse<>PERCUSSION then
    begin
    new(info);
    info.dwEventStart:=0;
    info.dwEventType:=seInstrument;
    info.dwData:=Cardinal(fInstrument);

    if Integer(fInstrument)>127 then
      begin
      info.dwChannel:=PERCUSSION;
      end
    else
      begin
      info.dwChannel:=ChannelInUse;
      end;

    tChannel:=info.dwChannel;
    Data.Add(info);
    end
else
    tChannel:=PERCUSSION;

tNote:=LimitValue(0,127,NoteVal);//Integer(fNote)+(12*fOctave);

//add note on
new(info);
info.dwEventStart:=0;
info.dwEventType:=seNoteOn;
info.dwChannel:=tChannel;

//percussion channel selected?
if (ChannelInUse<>PERCUSSION) and (tChannel=PERCUSSION) then
  info.dwData:=Integer(fInstrument)
else
  info.dwData:=tNote;
Data.Add(info);

//add note off
new(info);
info.dwEventStart:=fDuration;
info.dwEventType:=seNoteOff;
info.dwChannel:=tChannel;
if (ChannelInUse<>PERCUSSION) and (tChannel=PERCUSSION) then
  info.dwData:=Integer(fInstrument)
else
  info.dwData:=tNote;
Data.Add(info);

//play data
Result:=PlayData(false,true,Data);

//finished with tlist
Data.Free;


end;
//stop
//----------------------------------------------------------------------------
procedure TMidiGen.Stop;
begin
LoopAllowed:=false;

if (DeviceOpened) and (CanPlay) then
   begin
   midiStreamStop(OutHandle);
   end;


end;

//----------------------------------------------------------------------------
function TMidiGen.WaitForClose: bool;
begin

//are we already playing and can we do a stop?
if (CanPlay=false) or (MidiAvailable=false) then
   begin
   result:=false;
   exit;
   end;

//no more play calls for now
CanPlay:=false;
LoopAllowed:=false;

//close from previous use?
if DeviceOpened then
   begin
   midiStreamStop(OutHandle);
   end;

while DeviceOpened do
      begin
      Application.ProcessMessages;
      end;

Result:=true;
end;

//----------------------------------------------------------------------------
function TMidiGen.PlayData(ResetOnly:bool; PitchBendEnabled:bool; Data:TList):bool;
var
   prop: MIDIPROPTIMEDIV;
   edata:^event;
   err: Integer;
   i: Integer;
   dopb:bool;
   firstnoteoff:bool;
   DeltaTime,RunningTime:DWORD;

begin
Result:=false;
//currently in use by someone else?
if (IDInUse<>0) and (IDInUse<>ID) then exit;

ChannelInUse:=fChannel;

dopb:=(fPitchBend<>0) and PitchBendEnabled;


//only doing reset?
if not ResetOnly then
    begin
    //play instrument***************
    //reset channels
    //tag callback onto first event
    AddShortEvent(ResetChannel(0,ChannelInUse,true),DataBuffer,BufferSize,sEventCount);
    AddShortEvent(ResetChannel(0,PERCUSSION),DataBuffer,BufferSize,sEventCount);

    //set PB range to 12 semitones
    AddShortEvent(ShortEvent(0,ChannelInUse,seRPNLSB,$64),DataBuffer,BufferSize,sEventCount);
    AddShortEvent(ShortEvent(0,ChannelInUse,seRPNMSB,$65),DataBuffer,BufferSize,sEventCount);
    AddShortEvent(ShortEvent(0,ChannelInUse,sePBRange,($c*$100)+$6),DataBuffer,BufferSize,sEventCount);
    AddShortEvent(ShortEvent(0,ChannelInUse,seRPNLSB,$7f64),DataBuffer,BufferSize,sEventCount);
    AddShortEvent(ShortEvent(0,ChannelInUse,seRPNMSB,$7f65),DataBuffer,BufferSize,sEventCount);

    //pan
    //if fPan<>0 then
       begin
       //set pan to position
       AddShortEvent(DoPan(0,ChannelInUse,fPan),DataBuffer,BufferSize,sEventCount);
       AddShortEvent(DoPan(0,PERCUSSION,fPan),DataBuffer,BufferSize,sEventCount);
       end;

    //modulation
    //if fModulation>0 then
       AddShortEvent(DoModulation(0,ChannelInUse,fModulation),DataBuffer,BufferSize,sEventCount);

    //volume
    AddShortEvent(DoVolume(0,ChannelInUse,fVolume),DataBuffer,BufferSize,sEventCount);
    AddShortEvent(DoVolume(0,PERCUSSION,fVolume),DataBuffer,BufferSize,sEventCount);

    //sustain
    //if fSustain then
       AddShortEvent(DoSustain(0,ChannelInUse,fSustain),DataBuffer,BufferSize,sEventCount);

    //reverb
    //if fReverb>0 then
       AddShortEvent(DoReverb(0,ChannelInUse,fReverb),DataBuffer,BufferSize,sEventCount);

    //chorus
    //if fChorus>0 then
        AddShortEvent(DoChorus(0,ChannelInUse,fChorus),DataBuffer,BufferSize,sEventCount);


    //add data
    RunningTime:=0;
    firstnoteoff:=true;
    for i:=0 to Data.Count-1 do
        begin
        edata:=Data.Items[i];
        DeltaTime:=edata.dwEventStart-RunningTime;

        //no instrument specified at start so use property
        if (i=0) and (edata.dwEventType<>seInstrument) then
           begin
           AddShortEvent(AddInstrument(0,ChannelInUse,fInstrument),DataBuffer,BufferSize,sEventCount);
           end;

        //select event type
        case edata.dwEventType of

             //note on
             seNoteOn:
                      begin
                      if (edata.dwChannel=PERCUSSION) and (ChannelInUse<>PERCUSSION) then
                         begin
                         AddShortEvent(SetPercussion(DeltaTime,edata.dwData,127,true),DataBuffer,BufferSize,sEventCount);
                         end
                      else
                          begin
                          AddShortEvent(NoteOnDWord(DeltaTime,edata.dwChannel,edata.dwData,127),DataBuffer,BufferSize,sEventCount);
                          end;
                      end;//note on

             //note off
             seNoteOff:
                      begin
                      //pitch bend
                      if dopb and firstnoteoff then
                         begin
                         DoPitchBend(DeltaTime,fPBDelay,fPBDuration,fPitchBend,edata.dwChannel,DataBuffer,BufferSize,sEventCount);
                         firstnoteoff:=false;
                         end;

                       if (edata.dwChannel=PERCUSSION) and (ChannelInUse<>PERCUSSION) then
                          begin
                          AddShortEvent(SetPercussion(DeltaTime,edata.dwData,127,false),DataBuffer,BufferSize,sEventCount);
                          end
                       else
                           begin
                           AddShortEvent(NoteOnDWord(DeltaTime,edata.dwChannel,edata.dwData,0),DataBuffer,BufferSize,sEventCount);
                           end;
                      end; //noteoff

             //instrument change
             seInstrument:
                      begin
                      AddShortEvent(AddInstrument(DeltaTime,edata.dwChannel,TMGInstrument(edata.dwData)),DataBuffer,BufferSize,sEventCount);

                      end;//instrument

        end;//case

        //update running time
        RunningTime:=edata.dwEventStart;

        //dump entry
        Dispose(edata);

        end;//for i

    end;//reset only

//open midi stream
while DeviceOpened do
      begin
      Application.ProcessMessages;
      end;

//err:=midiStreamOpen(@OutHandle,@MidiDevice,1,DWORD (@MidiProc),Cardinal(self),CALLBACK_FUNCTION);
err:=midiStreamOpen(@OutHandle,@MidiDevice,1,DWORD (TMGHwnd),Cardinal(self),CALLBACK_WINDOW);

repeat
      Application.ProcessMessages;
until (DeviceOpened);


if err<>MMSYSERR_NOERROR then
        begin
        //mdshow('OpenErr');
        //mdshow(err);
        Exit;
        end;

//flag as in use by us
CurrentID:=ID;

//reset
midiOutReset(OutHandle);

//set time sig
prop.cbStruct:=sizeof(prop);
prop.dwTimeDiv:=50;
err:=midiStreamProperty(OutHandle,@prop,MIDIPROP_SET or MIDIPROP_TIMEDIV);

if err<>MMSYSERR_NOERROR then
        begin
        //mdshow('PropertyErr');
        //mdshow(err);
        Exit;
        end;

//put in midi header
FillMemory(@mhdr,HeaderSize,0);
mhdr.lpData:=DataBuffer;
mhdr.dwBufferLength:=BufferSize;
mhdr.dwBytesRecorded:=BufferSize;

//prepare header
err:=midiOutPrepareHeader(OutHandle,@mhdr,HeaderSize);
if err<>MMSYSERR_NOERROR then
        begin
        //mdshow('PrepareErr');
        //mdshow(err);
        Exit;
        end;

//send to stream
err:=midiStreamOut(OutHandle,@mhdr,HeaderSize);
if err<>MMSYSERR_NOERROR then
        begin
        //mdshow('OutErr');
        //mdshow(err);
        Exit;
        end;


//restart stream
err:=midiStreamRestart(OutHandle);
if err<>MMSYSERR_NOERROR then
        begin
        //mdshow('RestartErr');
        //mdshow(err);
        Exit;
        end;

Result:=true;
end;
//----------------------------------------------------------------------------
//is midi available
function TMidiGen.MidiAvailable:bool;
var
   tOutHandle:Integer;
   mmr:MMRESULT;

begin

if (DeviceOpened) then
   begin
   Result:=true;
   Exit;
   end;

//not currently in use?
//if IDInUse=0 then
   begin
    {while DeviceOpened do
          begin
          Application.ProcessMessages;
          end;}

    mmr:=midiOutOpen(@tOutHandle,MidiDevice,0,0,CALLBACK_NULL);
    midioutClose(tOutHandle);


    if mmr<>MMSYSERR_NOERROR then
       begin
       Result:=false;
       end
    else
       begin
       Result:=true;
       end;
   end;
//else
   begin
   //Result:=false;
   end;

end;
//----------------------------------------------------------------------------
//create normal instrument
function AddInstrument(Time:Integer; lChannel:TMGChannel; Instrument:TMGInstrument):sMIDIEVENT;
begin

if Integer(Instrument)>127 then Instrument:=TMGInstrument(127);
//if Instrument<0 then Instrument:=0;

Result:=ShortEvent(Time,lChannel,seInstrument,Cardinal(Instrument));

end;
//----------------------------------------------------------------------------
//create percussion instrument
function SetPercussion(Time:Integer; Instrument:DWORD; Level:DWORD; Hit: bool):sMIDIEVENT;
begin

Instrument:=Instrument-93;
if Instrument<35 then Instrument:=35;
if Instrument>81 then Instrument:=81;

//on or off?
if hit then
   begin
   //on
   Result:=NoteOnDWord(Time,PERCUSSION,Instrument,Level);
   end
else
   begin
   //off
   Result:=NoteOnDWord(Time,PERCUSSION,Instrument,0);
   end;

end;
//----------------------------------------------------------------------------
//end of play sequence event
procedure AddChannelEndEvent(lChannel:TMGChannel; var DataBuf:PChar; var BufSize:Integer; var EvCount:Integer);
begin

//all notes off
AddShortEvent(AllNotesOff(0,lChannel),DataBuf,BufSize,EvCount);
//midi reset
//AddShortEvent(ResetChannel(10,lChannel),DataBuf,BufSize,EvCount);

end;

//----------------------------------------------------------------------------
//all notes off
function AllNotesOff(Time:Integer; lChannel:TMGChannel):sMIDIEVENT;
begin

Result:=ShortEvent(Time,lChannel,seReset,123);
end;

//----------------------------------------------------------------------------
//create channel reset
function ResetChannel(Time:Integer; lChannel:TMGChannel; Callback:bool = false):sMIDIEVENT;
begin

Result:=ShortEvent(Time,lChannel,seReset,$79,Callback);

end;
//----------------------------------------------------------------------------
//create note on (value)
function NoteOnDWord(Time:Integer; lChannel:TMGChannel; Note:DWORD; Level:Integer):sMIDIEVENT;
var
   NoteVal: DWORD;

begin
NoteVal:=Level*$100;

if Note>127 then Note:=127;
//if Note<0 then Note:=0;

//add note number
NoteVal:=NoteVal or Note;

Result:=ShortEvent(Time,lChannel,seNoteOn,NoteVal);
end;
//----------------------------------------------------------------------------
//create note on (string)
function NoteOn(Time:Integer; lChannel:TMGChannel; Note:String; Octave:DWORD; Level:Integer):sMIDIEVENT;
var
   NoteNum:Integer;

begin

NoteNum:=GetNoteNumber(Note);


if NoteNum>127 then NoteNum:=127;
if NoteNum<0 then NoteNum:=0;

//add note number
Result:=NoteOnDWord(Time,lChannel,(Octave*12) + DWORD(NoteNum),Level);

end;
//----------------------------------------------------------------------------
//extract note number
function GetNoteNumber(NoteString:String):Integer;
var
   NotePos: Integer;

begin
NotePos:=AnsiPos(AnsiUpperCase(NoteString),NoteNumbers);
Result:=-1;

if NotePos>0 then
   Result:=StrToIntDef(String(NoteNumbers[NotePos-2])+String(NoteNumbers[NotePos-1]),0);

end;
//----------------------------------------------------------------------------
//create note off
function NoteOff(Time:Integer; lChannel:TMGChannel; Note:String; Octave:DWORD):sMIDIEVENT;
begin

//note on with zero volume
Result:=NoteOn(Time,lChannel,Note,Octave,0);

end;
//----------------------------------------------------------------------------
//sustain
function DoSustain(Time:Integer; lChannel:TMGChannel; EffectOn:bool):sMIDIEVENT;
var
   Level:DWORD;

begin
if EffectOn then
   Level:=$7f00
else
   Level:=$0;

Result:=ShortEvent(Time,lChannel,seSustain,Level+$40);

end;

//----------------------------------------------------------------------------
//chorus
function DoChorus(Time:Integer; lChannel:TMGChannel; LevelPC:Integer):sMIDIEVENT;
var
   level:Integer;

begin
level:=($7f * LevelPC) div 100;

Result:=ShortEvent(Time,lChannel,seChorus,(level*$100)+$5D);

end;

//----------------------------------------------------------------------------
//reverb
function DoReverb(Time:Integer; lChannel:TMGChannel; LevelPC:Integer):sMIDIEVENT;
var
   level:Integer;

begin
level:=($7f * LevelPC) div 100;

Result:=ShortEvent(Time,lChannel,seReverb,(level*$100)+$5b);

end;

//----------------------------------------------------------------------------