cmpmididata.pas

Delphi的另一款钢琴软件

    end
  finally
    f.Free;                          // Get rid of the stream
    ClearChanges
  end
end;

(*---------------------------------------------------------------------*
 | procedure TMidiData.Save;                                           |
 |                                                                     |
 | Save the MIDI data.                                                 |
 *---------------------------------------------------------------------*)
procedure TMidiData.Save;
var f : TFileStream;
begin
  f := TFileStream.Create (FileName, fmOpenWrite or fmShareExclusive or fmCreate);
  try
    WriteHeader (f);                 // Write the header.
    WriteTracks (f);                 // Write the tracks.
    ClearChanges
  finally
    f.Free;
  end
end;

(*---------------------------------------------------------------------*
 | procedure TMidiData.New;                                            |
 |                                                                     |
 | Initialise new data                                                 |
 *---------------------------------------------------------------------*)
procedure TMidiData.New;
begin
  Close;                            // Delete existing data
  FileName := '';                   // Clear the file name
  fActive := True
end;

(*---------------------------------------------------------------------*
 | procedure TMidiData.ReadHeader ();                                  |
 |                                                                     |
 | Read the midi header from the stream.                               |
 |                                                                     |
 | Parameters:                                                         |
 |   f : TStream                     // The stream to read from.       |
 *---------------------------------------------------------------------*)
procedure TMidiData.ReadHeader (f : TStream);
var
  hdr : array [0..3] of char;
  hSize : LongInt;
begin
  f.ReadBuffer (hdr, sizeof (hdr)); // Read the MIDI file signature.
  if StrLComp (hdr, 'MThd', 4) <> 0 then
    raise EMidiData.Create ('Invalid MIDI file ID');

  f.ReadBuffer (hSize, sizeof (hSize));
                                    // Read the header size
  hSize := SwapLong (hSize);
  if hSize < sizeof (fHeader) then
    raise EMidiData.Create ('Invalid MIDI header size');

                                    // Read the MIDI header
  f.ReadBuffer (fHeader, sizeof (fHeader));

  if hSize > sizeof (fHeader) then
  begin                             // Read the extra headr bytes.
    fHeaderExtraSize := hSize - sizeof (fHeader);
    GetMem (fHeaderExtra, fHeaderExtraSize);
    f.ReadBuffer (fHeaderExtra^, fHeaderExtraSize);
  end
  else
  begin                             // No extra header bytes.
   fHeaderExtraSize := 0;
   fHeaderExtra := Nil
  end
end;

(*---------------------------------------------------------------------*
 | procedure TMidiData.WriteHeader ();                                 |
 |                                                                     |
 | Write the MIDI header record.                                       |
 |                                                                     |
 | Parameters:                                                         |
 |   f : TStream                     // The stream to write to.        |
 *---------------------------------------------------------------------*)
procedure TMidiData.WriteHeader;
var
  hSize : LongInt;
begin
  f.WriteBuffer ('MThd', 4);         // Write MIDI ID
  hSize := SwapLong (fHeaderExtraSize + sizeof (fHeader));
                                     // Write the header size
  f.WriteBuffer (hSize, sizeof (hSize));
                                     // Write the header data
  f.WriteBuffer (fHeader, sizeof (fHeader));
  if fHeaderExtraSize > 0 then
                                     // Write thea header extra data.
    f.WriteBuffer (fHeaderExtra^, fHeaderExtraSize);
end;


(*---------------------------------------------------------------------*
 | procedure TMidiData.ReadTracks ();                                  |
 |                                                                     |
 | Read the tracks data.  Parse it into our own internal format.       |
 |                                                                     |
 | Parameters:                                                         |
 |   f : TStream                     // The stream to read from.       |
 *---------------------------------------------------------------------*)
procedure TMidiData.ReadTracks (f : TStream);
var
  nTracks, i : Integer;
  track : TMidiTrackStream;
begin
  nTracks := Swap (fHeader.nTracks);
  for i := 0 to nTracks - 1 do
  begin
    track := TMidiTrackStream.Create (100000);  // Reserve 1100000 bytes
    try
      track.LoadFromSMFStream (f);
      fTrackList.Add (track);
    except
      track.Free;
      raise
    end
  end
end;

(*---------------------------------------------------------------------*
 | procedure TMidiData.WriteTracks ();                                 |
 |                                                                     |
 | Write data for all tracks                                           |
 |                                                                     |
 | Parameters:                                                         |
 |   f : TStream                     // The stream to write to         |
 *---------------------------------------------------------------------*)
procedure TMidiData.WriteTracks (f : TStream);
var
  i : Integer;
begin
  for i := 0 to NoTracks - 1 do
    Tracks [i].SaveToSMFStream (f);
end;

(*---------------------------------------------------------------------*
 | function TMidiData.GetTrack () : TMidiTrack;                        |
 |                                                                     |
 | Get track 'n'                                                       |
 |                                                                     |
 | Parameters:                                                         |
 |   i : Integer                     // The track to get               |
 |                                                                     |
 | The function returns the specified track                            |
 *---------------------------------------------------------------------*)
function TMidiData.GetTrack (i : Integer) : TMidiTrackStream;
begin
  if i < fTrackList.Count then
    result := TMidiTrackStream (fTrackList [i])
  else
    result := Nil
end;

function TMidiData.AddNewTrack (i : Integer) : boolean;
var
  Track : TMidiTrackStream;
begin
  result := False;
  if (i > 0) and (NoTracks = 0) then
  begin
    AddNewTrack (0);
    result := True
  end;

  track := TMidiTrackStream.Create (100000);
  track.Init;
  fTrackList.Add (track);
  fHeader.nTracks := Swap (NoTracks);
  fChanges := True
end;

(*---------------------------------------------------------------------*
 | function TMidiData.GetShortFileName : string;                       |
 |                                                                     |
 | Gets the short file name for display purposes.                      |
 |                                                                     |
 | The function returns the short file name.                           |
 *---------------------------------------------------------------------*)
function TMidiData.GetShortFileName : string;
begin
  if FileName = '' then
    result := '<Untitled>'
  else
    result := ExtractFileName (FileName)
end;

(*---------------------------------------------------------------------*
 | procedure TMidiData.RemoveTrack ();                                 |
 |                                                                     |
 | Completely remove a specified track                                 |
 |                                                                     |
 | Parameters:                                                         |
 |   idx : Integer                   // The track to remove.           |
 *---------------------------------------------------------------------*)
procedure TMidiData.RemoveTrack (idx : Integer);
var track : TMidiTrackStream;
begin
  track := Tracks [idx];
  fChanges := True;
  if idx < NoTracks - 1 then
  begin
    track.Free;
    fTrackList [idx] := TMidiTrackStream.Create (100000);
    track := Tracks [idx];
    track.Init;
  end
  else
  begin
    if Assigned (track) then
    begin
      track.Free;
      fTrackList.Delete (idx)
    end;
    fHeader.nTracks := Swap (NoTracks)
  end
end;

(*---------------------------------------------------------------------*
 | procedure TMidiData.EraseTrack ();                                  |
 |                                                                     |
 | Erase all events from a track except for meta events.               |
 |                                                                     |
 | Parameters:                                                         |
 |   idx : Integer            // The track to remove events from       |
 *---------------------------------------------------------------------*)
procedure TMidiData.EraseTrack (idx : Integer);
begin
  if Assigned (Tracks [idx]) then
    Tracks [idx].EraseNonMetaEvents
end;

function TMidiData.GetChanges : boolean;
var
  i : Integer;
begin
  result := fChanges;
  if not result then
    for i := 0 to NoTracks - 1 do
      if Tracks [i].Changes then
      begin
        result := True;
        break
      end
end;

procedure TMidiData.ClearChanges;
var
  i : Integer;
begin
  fChanges := False;
  for i := 0 to NoTracks -1 do
    Tracks [i].Changes := False
end;

procedure TMidiData.LoadFromStream(data: TStream);
var
  f : TRiffMemoryStream;
  s : TMemoryStream;
  id : array [0..4] of char;
begin
  Active := False;
  if data.Size > 4 then
  begin
    data.Read (id, 4);
    id [4] := #0;
    data.Seek (0, soFromBeginning);
    if CompareText (id, 'RIFF') = 0 then
    begin
      f := Nil;
      s := TMemoryStream.Create;
      try
        s.CopyFrom (data, 0);
        f := TRiffMemoryStream.Create (s.Memory, s.Size);
        f.Descend ('RMID', MMIO_FINDRIFF);
        f.Descend ('data', MMIO_FINDCHUNK);
        ReadHeader (f);                  // Read the track header
        try
          ReadTracks (f);
          fActive := True;
        except
          Close;
          raise
        end
      finally
        s.Free;
        f.Free
      end
    end
    else
    begin
      try
        ReadHeader (data);
        ReadTracks (data);
        fActive := True
      except
        Close;
        raise
      end
    end
  end
end;

initialization
end.