📄 unitmiditrackstream.pas
字号:
SMFStream.WriteBuffer ('MTrk', 4);
ts := SwapLong (trackSize);
SMFStream.WriteBuffer (ts, sizeof (ts));
buffer := TMemoryStream.Create;
try
buffer.Size := trackSize;
DoPass (True);
buffer.Seek (0, soFromBeginning);
SMFStream.CopyFrom (buffer, trackSize)
finally
buffer.Free
end;
Seek (EventCount * sizeof (TMidiEventData), soFromBeginning);
end;
(*---------------------------------------------------------------------*
| function TMidiTrackStream.GetEvent () : PMidiEventData; |
| |
| Get the 'idx'th event in the buffer |
| |
| Parameters: |
| idx : Integer The event to get |
| |
| The function returns a pointer to the specified event. |
*---------------------------------------------------------------------*)
function TMidiTrackStream.GetEvent (idx : Integer) : PMidiEventData;
begin
if (idx >= 0) and (idx < EventCount) then
begin
result := PMidiEventData (Memory);
Inc (result, idx)
end
else result := Nil
end;
(*---------------------------------------------------------------------*
| procedure TMidiTrackStrean.SetTrackName (); |
| |
| Sets the track name by modifying the 'meta track name' midi event |
| |
| Parameters: |
| value : string The new track name |
*---------------------------------------------------------------------*)
procedure TMidiTrackStream.SetTrackName (const value : string);
var
Event : TEventData;
procedure SetNameEvent (var event : TEventData);
var len : Integer;
begin
len := Length (value);
event.status := midiMeta;
GetMem (Event.sysex, len + 1);
Event.sysex [0] := char (metaTrackName);
if len > 0 then Move (value [1], Event.sysex [1], Len);
end;
begin
if fTrackName <> Nil then
begin
FreeMem (fTrackName^.data.sysex);
SetNameEvent (fTrackName.data);
fTrackName^.sysexSize := Length (value) + 1;
fChanges := True;
end
else
begin
SetNameEvent (Event);
fTrackName := InsertEvent (0, Event, Length (value) + 1)
end
end;
(*---------------------------------------------------------------------*
| function TMidiTrackStream.GetTrackName : string; |
| |
| Get the track name |
| |
| The function returns the track name |
*---------------------------------------------------------------------*)
function TMidiTrackStream.GetTrackName;
var len : Integer;
begin
if fTrackName = Nil then
result := ''
else
begin
len := fTrackName^.sysexSize ;
if len = 0 then
result := ''
else
begin
SetLength (result, len - 1);
Move ((fTrackName^.data.sysex + 1)^, result [1], len - 1);
result := PChar (result);
end
end
end;
(*---------------------------------------------------------------------*
| procedure TMidiTrackStream.SetChannel (); |
| |
| Set the channel by modifying all 'channel' events |
| |
| Parameters: |
| value : TChannel // The new channel. |
*---------------------------------------------------------------------*)
procedure TMidiTrackStream.SetChannel (value : TChannel);
var
status : byte;
p :PMidiEventData;
i : Integer;
begin
if value <> fChannel then
begin
fChannel := value;
for i := 0 to EventCount - 1 do // Go thru the buffer...
begin
p := Event [i];
status := p^.data.status;
if status < midiSysex then // Is it a 'channel' event
status := status and midiStatusMask or fChannel;
p^.data.status := status;
end;
fChanges := True;
end
end;
(*---------------------------------------------------------------------*
| procedure TMidiTrackStream.SetPatch (); |
| |
| Set the ***Initial** patch by modifying all program change events |
| before the first Note message, or inserting one if there aren't any |
| |
| Parameters: |
| value : TChannel // The new channel. |
*---------------------------------------------------------------------*)
procedure TMidiTrackStream.SetPatch (value : TPatchNo);
var
p : PMidiEventData;
newEvent : TEventData;
i : Integer;
gotPatchChange : boolean;
status : byte;
begin
if value <> fPatch then
begin
fPatch := value;
gotPatchChange := False;
for i := 0 to EventCount - 1 do
begin
p := Event [i];
status := p^.data.status;
case status and midiStatusMask of
midiNoteOn, midiNoteOff :
break;
midiProgramChange :
begin
p^.data.b2 := value;
gotPatchChange := True
end
end
end;
if not gotPatchChange then
begin
newEvent.status := midiProgramChange + Channel;
newEvent.b2 := value;
newEvent.b3 := 0;
InsertEvent (0, newEvent, 0)
end;
end
end;
(*----------------------------------------------------------------------------*
| function TMidiTrackStream.FindEventNo () : Integer |
| |
| Find event at position. If there isn't an event at the position, return |
| the next event after the position. If we're beyond the last event, return |
| -1 |
| | |
| Parameters: |
| pos : Integer The position to find. |
| tp : TFindEventType Whether to find the first event, the last event |
| or any event. |
| |
| The function returns the index of the event. |
*----------------------------------------------------------------------------*)
function TMidiTrackStream.FindEventNo (pos : Integer; tp : TFindEventType) : Integer;
var
sp, ep, mp : Integer;
mev : PMidiEventData;
p : PMidiEventData;
begin
p := Memory;
sp := 0;
ep := EventCount - 1;
mp := 0;
mev := Nil;
while ep >= sp do // Do a binary search on the event buffer
begin
mp := sp + (ep - sp) div 2;
mev := p;
Inc (mev, mp); // Get the middle event
if pos > mev^.pos then
sp := mp + 1 // Search the upper half of the buffer
else
if pos < mev^.pos then
ep := mp - 1 // Search the lower half of the buffer
else
break // We've found the event
end;
while (mev <> Nil) and (mev^.pos < pos) do
begin
Inc (mp); // Make sure we're on the next event if the
if mp < EventCount then
mev := Event [mp]
else
break
end; // position wasn't found.
if mp >= EventCount then // End of buffer ?
mp := -1
else
begin
mev := p; // Now go to the first or last matching event
Inc (mev, mp);
if mev^.pos = pos then
case tp of
feLast : while (mp + 1 < EventCount) and (Event [mp + 1]^.pos = pos) do Inc (mp);
feFirst : while (mp - 1 >= 0) and (Event [mp - 1]^.pos = pos) do Dec (mp)
end;
end;
result := mp
end;
(*---------------------------------------------------------------------*
| function TMidiTrackStream.FindEvent () : PMidiEventData; |
| |
| Find an event at a specified position (in ticks). The tyype (tp) |
| indicates whether the function should return any event at the |
| specified position; the first event at the specified position, or |
| the last event at the specified position. If no event is found at |
| the position, the function returns the next event after the |
| position, or Nil if there aren't any. |
| |
| Parameters: |
| pos : Integer; |
| tp : TFindEventType |
| |
| The function returns the specified event. |
*---------------------------------------------------------------------*)
function TMidiTrackStream.FindEvent (pos : Integer; tp : TFindEventType) : PMidiEventData;
begin
result := Event [FindEventNo (pos, tp)];
end;
function TMidiTrackStream.InsertEvent (pos : Integer; var data : TEventData; sysexSize : Integer) : PMidiEventData;
var
no : Integer;
p, p1 : PMidiEventData;
RecalcFlag : boolean;
begin
RecalcFlag := False;
p := Event [EventCount - 1];
if (p <> Nil) and (p^.data.status = midiMeta) and (p^.data.sysex [0] = char (metaTrackEnd)) and (p^.pos < pos) then
p^.pos := pos;
if Size < (EventCount + 1) * sizeof (TMidiEventData) then
Size := (EventCount + 1) * sizeof (TMidiEventData);
if EventCount > 0 then
begin
no := FindEventNo (pos, feLast);
if no = -1 then // End of track must exist !
raise EMidiTrackStream.Create ('System error inserting event');
end
else no := -1; // No events at all. Must be inserting end of track.
p := Memory;
if no <> -1 then
begin
Inc (p, no);
p1 := p;
Inc (p1);
if (no < EventCount - 1) and (pos = p^.pos) then
begin
p := p1;
Inc (p1);
Inc (no)
end;
Move (p^, p1^, sizeof (TMidiEventData) * (EventCount - no));
if no < EventCount - 1 then
RecalcFlag := True;
end;
p^.pos := pos;
p^.sysexSize := sysexSize;
p^.data := data;
Inc (fEventCount);
if RecalcFlag and (fUpdateCount = 0) then
CalcOnOffPointers;
fChanges := True;
result := p
end;
function TMidiTrackStream.InsertMetaEvent (pos : Integer; metaEvent : byte; data : PChar; dataLen : Integer) : PMidiEventData;
var
event : TEventData;
begin
event.status := midiMeta;
GetMem (event.sysex, dataLen + 1);
event.sysex [0] := char (metaEvent);
if dataLen > 0 then
Move (data [0], event.sysex [1], dataLen);
result := InsertEvent (pos, event, dataLen + 1);
end;
procedure TMidiTrackStream.DeleteEvent (eventNo : Integer);
var
p1, p2 : PMidiEventData;
begin
p1 := Event [eventNo];
if Assigned (p1) then
begin
if p1^.sysexSize > 0 then
FreeMem (p1^.data.sysex);
if eventNo < EventCount - 1 then
begin
p2 := p1;
Inc (p2);
Move (p2^, p1^, (EventCount - EventNo - 1) * sizeof (TMidiEventData))
end;
fChanges := True;
Dec (fEventCount);
if fUpdateCount = 0 then
CalcOnOffPointers;
end
else
raise Exception.Create ('Invalid event no');
end;
(*---------------------------------------------------------------------*
| procedure TMidiTrackStream.GetEventRange (); |
| |
| Get range of events to be deleted, copied, etc. The range may |
| contain 'stubs'; where note-on is outside the range (shouldn't be |
| operated on), or 'orphans' where the note-off is outside the range, |
| and should be operated on (including the orphan). |
| |
| Parameters: |
| startPos Range start position. |
| endPos Range end position |
| startEvent Returns the first event in the range |
| endEvent Returns the last event in the range. |
*---------------------------------------------------------------------*)
function TMidiTrackStream.GetEventRange (startPos, endPos : Integer; var startEvent, endEvent : Integer) : boolean;
begin
startEvent := FindEventNo (startPos, feFirst); // Find first event in range
endEvent := FindEventNo (endPos, feLast); // Find last event in range
if startEvent <> -1 then
begin
if endEvent = -1 then // endPos is beyond end of song.
endEvent := EventCount - 2 // Make it the event before the
// end-of-track
else
begin
// FindEventNo will return the
// next event if no event is
// found at the position.
if Event [endEvent].pos > endPos then
Dec (endEvent); // Adjust for this...
if endEvent >= EventCount - 1 then // protect 'end of track' meta event.
Dec (endEvent)
end;
result := endEvent >= startEvent
end
else result := False
end;
(*---------------------------------------------------------------------*
| procedure TMidiTrackStream.CalcRangeDataSize (); |
| |
| Calc size of requied DDE buffer to save events into. Includes size |
| of the events (excluding stubs, but including orphans), and size of |
| sysex. |
| |
| Parameters: |
| startEvent First event in the range |
| endEvent Last event in the range. |
| startPos Range start position. |
| endPos Range end position |
*---------------------------------------------------------------------*)
function TMidiTrackStream.CalcRangeDataSize (startEvent, endEvent, startPos, endPos : Integer) : Integer;
var
blockSize : Integer;
p : PMidiEventData;
sts : byte;
begin
// Calculate size of DDE buffer - big enough for
// header & events
blockSize := (endEvent - startEvent + 1) * sizeof (TMidiEventData) + sizeof (TMidiEventClipboardHeader);
p := Event [startEvent];
// Go through selected events, add size of sysex messages,
// and adjust for stubs and orphans.
while endEvent >= startEvent do
begin
if p^.sysexSize > 0 then // Add sysex size
Inc (blockSize, p^.sysexSize);
sts := p^.data.status and midiStatusMask;
// Add space for orphan midi-off
if (sts = midiNoteOn) and (p^.OnOffEvent^.pos > endPos) then
Inc (blockSize, sizeof (TMidiEventData));
// Remove space for stub midi-on.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -