TMIDIPlayerComp

[EWeiss]

Danke!

Ersetzt mal bitte die procedure TMidiDriver.DoOnMidiTimer in der MidiPlayer2.pas

Delphi-Quellcode:

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;

Sollten dann immer noch Probleme auftauchen in Verbindung mit den Sytem Exclusiven Messagen..
Dann bitte eine/die Datei hochladen wo das Problem auftritt.

Wenn die Problem durch die Änderung behoben sein sollten lade ich ein neues Archiv hoch.

gruss