unitmiditrackstream.pas

Delphi的另一款钢琴软件

    if ((sts = midiNoteOff) or ((sts = midiNoteOn) and (p^.data.b3 = 0))) and (p^.OnOffEvent^.pos < startPos) then
      Dec (blockSize, sizeof (TMidiEventData));

    Inc (p);
    Dec (endEvent)
  end;

  result := blockSize
end;


(*---------------------------------------------------------------------*
 | function CompareEvents (): Integer                                  |
 |                                                                     |
 | 'Compare' function used in sorting orphan lists.                    |
 |                                                                     |
 | Parameters:                                                         |
 |   p1, p2                    Events to compare.                      |
 *---------------------------------------------------------------------*)
function CompareEvents (p1, p2 : pointer) : Integer;
begin
  if PMidiEventData (p1)^.pos > PMidiEventData (p2)^.pos then
    result := 1
  else
    if PMidiEventData (p1)^.pos < PMidiEventData (p2)^.pos then
      result :=-1
    else
      if Integer (p1) > Integer (p2) then
        result := 1
      else
        result := -1
end;

(*---------------------------------------------------------------------*
 | procedure TMidiTrackStream.GetRangeData ();                         |
 |                                                                     |
 | Fill DDE buffer from range. Buffer ends up with:                    |
 |    Header                                                           |
 |    Events                                                           |
 |    Orphans                                                          |
 |    Sysex Data                                                       |
 |                                                                     |
 | Parameters:                                                         |
 |   buffer                    The buffer to fill                      |
 |   startPos                  Range start position.                   |
 |   startEvent                First event in the range                |
 |   endEvent                  Last event in the range.                |
 |   endPos                    Range end position                      |
 *---------------------------------------------------------------------*)
procedure TMidiTrackStream.GetRangeData (buffer : PChar; startPos, startEvent, endEvent, endPos : Integer);
var
  i, bufferedEvents : Integer;
  pSrc, pDst : PMidiEventData;
  buf : PChar;
  OrphanList : TList;
  sts : byte;

begin
  buf := buffer;
                             // Set up DDE header in buffer
  with PMidiEventClipboardHeader (buf)^ do
  begin
    noEvents := endEvent - startEvent + 1; // Save nominal event count.  Stubs
                                           // will be removed and orphans added...
    startPosn := startPos
  end;

                                           // Copy events into buffer
  pSrc := Event [startEvent];
  pDst := PMidiEventData (buffer + sizeof (TMidiEventClipboardHeader));

  OrphanList := Nil;
  bufferedEvents := 0;

  for i := startEvent to endEvent do
  begin
    sts := pSrc^.data.status and midiStatusMask;
    if (sts = midiNoteOn) and (pSrc^.OnOffEvent^.pos > endPos) then
    begin                                  // Add orphaned note-off to orphan list
      if not Assigned (OrphanList) then
      begin
        OrphanList := TList.Create;
        OrphanList.Capacity := 64
      end;
      OrphanList.Add (pSrc^.OnOffEvent)
    end;

    if not (((sts = midiNoteOff) or ((sts = midiNoteOn) and (pSrc^.data.b3 = 0))) and (pSrc^.OnOffEvent^.pos < startPos)) then
    begin                                   // Copy event if it's not a 'stub'
      Move (pSrc^, pDst^, sizeof (TMidiEventData));
      Inc (pDst);
      Inc (bufferedEvents)
    end
    else                                    // Remove stub from header event count.
      Dec (PMidiEventClipboardHeader (buf)^.noEvents);

    Inc (pSrc);
  end;

  if Assigned (OrphanList) then             // Copy orphans to buffer
  try
                                            // Add orphans count to header event count
    with PMidiEventClipboardHeader (buf)^ do
      Inc (noEvents, OrphanList.Count);

    if OrphanList.Count > 1 then            // .. because of VCL bug...
      OrphanList.Sort (CompareEvents);

    for i := 0 to OrphanList.Count - 1 do   // Copy orphans
    begin
      Move (OrphanList [i]^, pDst^, sizeof (TMidiEventData));
      Inc (pDst);
    end
  finally
    OrphanList.Free
  end;


  pSrc := PMidiEventData (buffer + sizeof (TMidiEventClipboardHeader));
  buffer := PChar (pDst);                   // sysex data comes after orphans
                                            // Move sysex data for each event into buffer
  for i := 0 to bufferedEvents - 1 do
  begin
    if pSrc^.sysexSize > 0 then
    begin
      move (pSrc^.data.sysex^,buffer^, pSrc^.sysexSize);
      pSrc^.data.sysex := buffer;           // Make the buffered event point to
                                            // the buffered sysex, instead of it's
                                            // original sysex.
      Inc (buffer, pSrc^.sysexSize)
    end;

    Inc (pSrc)
  end
end;

(*---------------------------------------------------------------------*
 | procedure TMidiTrackStream.DeleteRange ();                          |
 |                                                                     |
 | Delete data between the specified range.  Don't delete stubs, but   |
 | delete orphans.                                                     |
 |                                                                     |
 | Parameters:                                                         |
 |   startPos                  Range start position.                   |
 |   endPos                    Range end position                      |
 *---------------------------------------------------------------------*)
procedure TMidiTrackStream.DeleteRange (startPos, endPos : Integer);
var
  n1, n2, i : Integer;
  p, p1, pClearRange : PMidiEventData;
  deleteNoEvents : Integer;
  sts : byte;
  eventNo : Integer;
  OrphanList : TList;
begin
  if GetEventRange (startPos, endPos, n1, n2) then
  begin
    deleteNoEvents := n2 - n1 + 1;  // Nominal no of events to delete
    p := Event [n1];
    pClearRange := p;

    OrphanList := Nil;

    // First pass.  Delete thhe sysex data, get the orphan list, and calculate
    // the 'clear range'.  The clear range can be deleted in one hit.  It starts
    // after the last stub.

    for i := 0 to deleteNoEvents - 1 do
    begin
      sts := p^.data.status and midiStatusMask;
      if (sts = midiNoteOn) and (p^.OnOffEvent^.pos > endPos) then
      begin                                         // Add orphan to list.
        if not Assigned (OrphanList) then
        begin
          OrphanList := TList.Create;
          OrphanList.Capacity := 64
        end;
        OrphanList.Add (p^.OnOffEvent)
      end;

      if not (((sts = midiNoteOff) or ((sts = midiNoteOn) and (p^.data.b3 = 0))) and (p^.OnOffEvent^.pos < startPos)) then
      begin                              // Not a stub.  Delete it's sysex
        if p^.sysexSize <> 0 then        // and mark it for deletion by setting sysexSize to MaxWord
          FreeMem (p^.data.sysex);
        p^.sysexSize := MaxWord
      end
      else
      begin
        pClearRange  := p;
        Inc (pClearRange)
      end;
      Inc (p);
    end;

    // Delete orphans - they're off the end of the range, and may not be consecutive
    if Assigned (OrphanList) then
    try
      if OrphanList.Count > 1 then
        OrphanList.Sort (CompareEvents);

      for i := OrphanList.Count - 1 downto 0 do
      begin
        p1 := OrphanList [i];
        Inc (p1);
        eventNo := (Integer (p1) - Integer (Event [0])) div sizeof (TMidiEventData);
        Move (p1^, OrphanList [i]^, (EventCount - eventNo - 1) * sizeof (TMidiEventData));
        Dec (fEventCount)
      end
    finally
      OrphanList.Free
    end;

    // Delete clear range - ie. most of the events.  the clear range starts after the
    // last stub.
    eventNo := (Integer (pClearRange) - Integer (Event [0])) div sizeof (TMidiEventData);
    if p <> pClearRange then
    begin
      Move (p^, pClearRange^, (EventCount - n2 - 1) * sizeof (TMidiEventData));
      Dec (fEventCount, n2 - eventNo + 1)
    end;

    // Delete events before the clear range that are marked for deletion (ie. which aren't stubs)
    p := Event [n1];
    i := n1;
    while i < eventNo do
    begin
      if ((p^.data.status and midiStatusMask) <> midiSysex) and ( p^.SysexSize = MaxWord) then
      begin
        p1 := p;
        Inc (p1);
        Move (p1^, p^, (EventCount - i) * sizeof (TMidiEventData));
        Dec (fEventCount);
        Dec (EventNo)
      end
      else
      begin
        Inc (i);
        Inc (p)
      end
    end;

    CalcOnOffPointers;
    fChanges := True;

    // ** TODO - maybe decrease buffer size here.
  end
end;

procedure TMidiTrackStream.CopyToClipboard (startPos, endPos : Integer);
var
  startEvent, endEvent, blockSize : Integer;
  data : THandle;
  ptr : PChar;
begin
  if GetEventRange (startPos, endPos, startEvent, endEvent) then
  begin
    blockSize := CalcRangeDataSize (startEvent, endEvent, startPos, endPos);
                            // Allocate DDE buffer
    data := GlobalAlloc (GMEM_MOVEABLE or GMEM_DDESHARE, blockSize);
    ptr := GlobalLock (data);
    if ptr <> Nil then
    try
      GetRangeData (ptr, startPos, startEvent, endEvent, endPos);
      GlobalUnlock (data);
    except
      GlobalUnlock (data);
      GlobalFree (data);
      raise
    end;

    Clipboard.SetAsHandle (trackClipboardFormat, data);
  end
end;

procedure TMidiTrackStream.DeleteToClipboard (startPos, endPos : Integer);
begin
  CopyToClipboard (startPos, endPos);
  DeleteRange (startPos, endPos)
end;

procedure TMidiTrackStream.CutToClipboard (startPos, endPos : Integer);
begin
  CopyToClipboard (startPos, endPos);
  DeleteRange (startPos, endPos);
  // ** TODO Shrink events
end;

procedure TMidiTrackStream.PasteFromClipboard (Pos : Integer);
var
  Handle : THandle;
begin
  Clipboard.Open;
  try
    Handle := Clipboard.GetAsHandle (trackClipboardFormat);
    if Handle <> 0 then
    begin
      MessageBeep ($ffff);
      // ** Todo - finish the thang
    end
  finally
    Clipboard.Close
  end
end;

(*---------------------------------------------------------------------*
 | procedure TMidiTrackStream.EraseNonMetaEvents ();                   |
 |                                                                     |
 | Erase all events from a track except for meta events.               |
 *---------------------------------------------------------------------*)
procedure TMidiTrackStream.EraseNonMetaEvents;
var
  i, count : Integer;
  sp, ep : PMidiEventData;
begin
  fChanges := True;
  count := EventCount;
  sp := Memory;
  i := 0;
  while i < count do
  begin
    if sp^.data.status <> midiMeta then
                                    // Not a meta event.  Find the next meta
                                    // meta event, and delete everything up to it.
    begin
      ep := sp;
      while i < count do
      begin
        Inc (ep);
        Dec (count);
        if ep^.data.status = midiMeta then break
      end;
                                    // Found the next meta event.
      if i < count then Move (ep^, sp^, (count - i) * sizeof (TMidiEventData));
    end;
    Inc (sp);
    Inc (i)
  end;
  fEventCount := count
end;

procedure TMidiTrackStream.CalcOnOffPointers;
var
  i, count, t, s, b, n : Integer;
  sp : PMidiEventData;
  noteOns : array [0..4, TNote] of PMidiEventData;
  noteOnCount : array [TNote] of byte;
begin
  count := EventCount;
  sp := Memory;
  i := 0;
  ZeroMemory (@noteOnCount, sizeof (noteOnCount));
  while i < count do
  begin
    t := 0;
    s := sp^.data.status and midiStatusMask;
    if s = midiNoteOn then
      if sp^.data.b3 <> 0 then
        t := 1
      else
        t := 2
    else
      if s = midiNoteOff then t := 2;

    case t of
      1 :
        begin
          b := sp^.data.b2;
          n := NoteOnCount [b];
          if n < 5 then
          begin
            noteOns [n, b] := sp;
            NoteOnCount [b] := n + 1
          end
        end;

      2 :
        begin
          b := sp^.data.b2;
          n := NoteOnCount [b];
          if n > 0 then
          begin
            Dec (n);
            sp^.OnOffEvent := NoteOns [n, b];
            NoteOns [n, b]^.OnOffEvent := sp;
            NoteOnCount [b] := n
          end
        end
    end;

    Inc (i);
    Inc (sp);

  end;

  try
    for i := Low (TNote) to High (TNote) do
      if NoteOnCount [i] <> 0 then
//        raise Exception.Create ('Note ons don''t match note offs');
  except
    raise
  end
end;

function TMidiTrackStream.IndexOf (p : PMidiEventData) : Integer;
var
  q : PMidiEventData;
begin
  q := Memory;
  result := (Integer (p) - Integer (q)) div sizeof (TMidiEventData);
end;

procedure TMidiTrackStream.BeginUpdate;
begin
  Inc (fUpdateCount)
end;

procedure TMidiTrackStream.EndUpdate;
begin
  if fUpdateCount > 0 then
  begin
    Dec (fUpdateCount);
    if fUpdateCount = 0 then
      CalcOnOffPointers
  end
end;

procedure TMidiTrackStream.CancelUpdate;
begin
  if fUpdateCount > 0 then
    Dec (fUpdateCount);
end;

initialization
  trackClipboardFormat := RegisterClipboardFormat ('PowerseqMidiTrackData');
end.