procedure TMidiDriver.DoOnMidiTimer;
var
i: Integer;
TickTime: LongWord;
DeltaTime: LongWord;
AMidiTrack: TMidiTrack;
pEvent: pMidiEvent;
EventCode: byte;
ChannelNo: byte;
ActiveNoteRemains: boolean;
OutNote: byte;
EventPositon: LongWord;
tmpSuspend: boolean;
SysExMsg: AnsiString;
begin
if not Assigned(MidiFile) then Exit;
TickTime := GetTickCount;
if LastOutputTime = 0 then
begin
DeltaTime := TickTime - FStartTime;
FCurrentTime := round(DeltaTime * FSpeed);
end else
begin
DeltaTime := TickTime - LastOutputTime;
FCurrentTime := FCurrentTime + round(DeltaTime * FSpeed);
end;
LastOutputTime := TickTime;
FCurrentPos := MidiFile.Time2TickPos(FCurrentTime);
if FFirePosition > 0 then // if we set to fire on specified Position
begin
if FCurrentPos >= FFirePosition then
begin
if not FFired then // to suppress multiple events on specified Position
begin
FFired := true;
// exit if return value is not 0
if SendMessage(FPlayerHandle, WM_MIDI_ArrivedAtFirePos, FCurrentTime, FCurrentPos) <> 0 then
exit;
end;
end else
if FFired then FFired := false;
end;
// Set back to the start position of specified interval, when player reachs the end position
// of specified interval, if we activated repeat-interval function.
tmpSuspend := false;
if FRepeatSection then
if FCurrentPos >= FEndPos then
begin
tmpSuspend := true;
Suspend := true;
MidiOut.SentAllNotesOff;
SetCurrentPos(FBeginPos);
// PostMessage(FPlayerHandle, WM_MIDI_PosChangeByRepeat, FBeginPos, FCurrentPos);
end;
// I have found a MIDI file which does not have the end of track mark.
// Following sentences are for the case to stop playing forcibly.
if FCurrentTime > (MidiFile.Duration + 300) then
begin
Suspend := true; // to prohibit calling DoOnMidiTimer in PlayThread
if FStepMode then
SendMessage(FPlayerHandle, WM_MIDI_EndOfTrack, 0, 1)
else
PostMessage(FPlayerHandle, WM_MIDI_EndOfTrack, 0, 1);
exit;
end;
for i := 0 to MidiFile.TrackCount - 1 do
begin
AMidiTrack := MidiFile.GetTrack(i);
if not AMidiTrack.EndOfTrack then
with AMidiTrack do
begin
while (AMidiTrack.PlayPos < AMidiTrack.EventCount) do
begin
pEvent := GetEvent(PlayPos);
EventPositon := pEvent^.Positon;
if (Round(FCurrentPos) <= EventPositon) then
break;
// Got the verse change event ?
// ( * This is not a standard MIDI event, It's just to support custom specification)
if (pEvent^.Event = $B0) and (pEvent^.Data1 = $14) then // verse change event ?
begin
if FVerseNum <> pEvent^.Data2 then
begin
PostMessage(FPlayerHandle, WM_MIDI_VerseChange, FVerseNum, pEvent^.Data2);
FVerseNum := pEvent^.Data2;
end;
PlayPos := PlayPos + 1;
continue;
end;
if PEvent.Event = $FF then
ProcessEvent(i, pEvent)
else if AMidiTrack.Active then
begin
EventCode := pEvent^.Event and $F0;
ChannelNo := pEvent^.Event and $0F;
if pEvent^.Msg = '' then // Not a System Exclusive Message ?
begin
ActiveNoteRemains := IsActiveNote(ChannelNo);
// The note number for drum channel defines the different percussion instruments,
// So, we should not change that.
if ChannelNo = DrumChannel then // Drum channel ?
OutNote := pEvent^.Data1
// Output the adjusted note number for the Note On, Note Off and Note Aftertouch Events
// by FPitch value.
else if (EventCode = $80) or (EventCode = $90) or (EventCode = $A0) then
begin
OutNote := pEvent^.Data1 + FPitch;
if (EventCode = $80) or ((EventCode = $90) and (pEvent^.Data2 = 0)) then
begin
if FChannelState[ChannelNo] then
DeleteConvRecord(pEvent^.Event and $0F, pEvent^.Data1, OutNote)
end else if FChannelState[ChannelNo] then
AddConvRecord(pEvent^.Event and $0F, pEvent^.Data1, OutNote);
end else
OutNote := pEvent^.Data1;
if FChannelState[ChannelNo] then
begin
// if event code is Bank select or Program change, Skip if pre-assigned instrument
// should be applied
if (EventCode <> $B0) and (EventCode <> $C0) then
MidiOut.PutShort(pEvent^.Event, OutNote, pEvent^.Data2)
else if CanOutput(pEvent) then
MidiOut.PutShort(pEvent^.Event, OutNote, pEvent^.Data2);
end else
begin
if ActiveNoteRemains then
begin
// $B0 + ChannelNo : Control change, 123 : All Notes Off
MidiOut.PutShort($B0 + ChannelNo, 123, pEvent^.Data2);
ClearChannelRecord(ChannelNo);
end;
// Activate following 2 lines if we want to process Control change messages and
// Program change messages regardless of channel's On/Off state.
if (EventCode = $B0) or (EventCode = $C0) then
// if event code is Bank select or Program change, Skip if pre-assigned instrument
// should be applied
if CanOutput(pEvent) then
MidiOut.PutShort(pEvent^.Event, pEvent^.Data1, pEvent^.Data2);
end;
end else
if (not NoExclusiveMsg) then // for (pEvent^.Msg <> '')
if (EventCode = $F0) or (EventCode = $F7) then // $F7 - used as a Message continuation mark
begin
// if FChannelState[ChannelNo] then
// MidiOut.PutLong(pAnsiChar(pEvent^.Msg), Length(pEvent^.Msg)); // * missed event code
// * Bug fix : correction for missed event code (01 Jun 2015)
SysExMsg := AnsiChar(EventCode) + pEvent^.Msg;
MidiOut.PutLong(@SysExMsg[1], Length(SysExMsg));
end;
// if FChannelState[ChannelNo] then
if (FChannelState[ChannelNo] or (pEvent^.Msg <> '')) and (EventCode <> $B0)
and (EventCode <> $C0) then
begin
if FStepMode then
SendMessage(FPlayerHandle, WM_MIDI_Event, i, integer(pEvent))
else
PostMessage(FPlayerHandle, WM_MIDI_Event, i, integer(pEvent));
end else
if (EventCode = $B0) or (EventCode = $C0) then
if CanOutput(pEvent) then
if FStepMode then
SendMessage(FPlayerHandle, WM_MIDI_Event, i, integer(pEvent))
else
PostMessage(FPlayerHandle, WM_MIDI_Event, i, integer(pEvent));
end;
// Messages for meta event are posted in the procedure ProcessEvent.
{ if FStepMode then
SendMessage(FPlayerHandle, WM_MIDI_Event, i, integer(pEvent))
else
PostMessage(FPlayerHandle, WM_MIDI_Event, i, integer(pEvent)); }
PlayPos := PlayPos + 1;
end;
end;
end;
if FStepMode then
SendMessage(FPlayerHandle, WM_MIDI_PosUpdate, FCurrentTime, FCurrentPos)
else
PostMessage(FPlayerHandle, WM_MIDI_PosUpdate, FCurrentTime, FCurrentPos);
if tmpSuspend then
Suspend := false;
end;