www.pudn.com > d4psp31.zip > cmpTempoMap.pas, change:1998-11-03,size:4781b


unit cmpTempoMap; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  cmpBarControl, unitMidiGlobals; 
 
const 
  MaxTempoChanges = 512; 
 
type 
  TTempoChange = object 
    fx, fy : Integer; 
    fEvent : PMidiEventData; 
    selected : boolean; 
    procedure Init (x, y : Integer; Event : PMidiEventData; isSelected : boolean); 
  end; 
 
  TTempoMap = class(TBarControl) 
  private 
    fNoTempoChanges : Integer; 
    fTempoChangeMap : array [0..MaxTempoChanges - 1] of TTempoChange; 
    fPrevY : Integer; 
    fMaxTempo: Integer; 
    procedure CalcTempoMap; 
    procedure SetMaxTempo(const Value: Integer); 
  protected 
    procedure DisplayBarMapContents; override; 
    procedure CalcBarMap; override; 
    { Protected declarations } 
  public 
    constructor Create (AOwner : TComponent); override; 
  published 
    property MaxTempo : Integer read fMaxTempo write SetMaxTempo default 300; 
  end; 
 
procedure Register; 
 
implementation 
 
uses unitMidiTrackStream; 
 
procedure Register; 
begin 
  RegisterComponents('MIDI', [TTempoMap]); 
end; 
 
{ TTempoMap } 
 
procedure TTempoMap.CalcBarMap; 
begin 
  inherited; 
  CalcTempoMap 
end; 
 
procedure TTempoMap.CalcTempoMap; 
var 
  p : PMidiEventData; 
  i, idx, h : Integer; 
  s : byte; 
  tempo : Integer; 
  prevTempo : Integer; 
 
  procedure AddTempoChange (tempo : Integer; e : PMidiEventData); 
  var 
    x, y : Integer; 
    selected : boolean; 
  begin 
    if fNoTempoChanges < MaxTempoChanges then 
    begin 
      with MidiData.Tracks [Track] do 
      begin 
        selected := (e^.pos >= SelStartPos) and (e^.pos <= SelEndPos); 
        x := CalcPosX (e^.pos); 
      end; 
      y := h - (tempo + VertScrollbar.Position) * h div MaxTempo + h div 2; 
      fTempoChangeMap [fNoTempoChanges].Init (x, y, e, selected); 
      Inc (fNoTempoChanges) 
    end 
  end; 
 
begin 
  h := ActiveRect.Bottom - BottomMargin; 
  fNoTempoChanges := 0; 
 
  if (Not Assigned (MidiData)) or (not Assigned (MidiData.Tracks [Track])) then Exit; 
 
  idx := MidiData.Tracks [Track].FindEventNo (Iterator.Position, feFirst); 
  if idx = -1 then exit; 
 
  i := idx - 1; 
  prevTempo := GetBPM (600, Iterator.BeatDiv); 
  while i >= 0 do 
  begin 
    Dec (i); 
    if i < 0 then break; 
    p := MidiData.Tracks [Track].Event [idx]; 
    s := p^.data.status; 
    if (s = midiMeta) and (byte (p^.data.sysex [0]) = metaTempoChange) then 
    begin 
      prevTempo :=(LongInt (p^.data.sysex [3]) + 256 * LongInt (p^.data.sysex [2]) + 65536 * LongInt (p^.data.sysex [1])) div 1000; 
      prevTempo := GetBPM (prevTempo, Iterator.BeatDiv); 
      break 
    end 
  end; 
 
  fPrevY := h - (prevTempo + VertScrollbar.Position) * h div MaxTempo + h div 2; 
 
  while idx < MidiData.Tracks [Track].EventCount do 
  begin 
    p := MidiData.Tracks [Track].Event [idx]; 
    if p^.pos > EndPosition then break; 
 
    s := p^.data.status; 
    if (s = midiMeta) and (byte (p^.data.sysex [0]) = metaTempoChange) then 
    begin 
      tempo :=(LongInt (p^.data.sysex [3]) + 256 * LongInt (p^.data.sysex [2]) + 65536 * LongInt (p^.data.sysex [1])) div 1000; 
      tempo := GetBPM (tempo, CalcPosBeatDiv (p^.pos)); 
      AddTempoChange (tempo, p) 
    end; 
    Inc (idx); 
  end 
end; 
 
constructor TTempoMap.Create(AOwner: TComponent); 
begin 
  inherited Create (AOwner); 
  VertScrollBar.LargeChange := 1; 
  VertScrollBar.SetParams (150, 0, 300); 
  fMaxTempo := 300; 
end; 
 
procedure TTempoMap.DisplayBarMapContents; 
var 
  n : Integer; 
  region : HRgn; 
  oldColor : TColor; 
  prevY : Integer; 
begin 
  with Canvas do 
  begin 
    Refresh; 
    oldColor := brush.Color; 
 
    region := CreateRectRgn (ActiveRect.left, ActiveRect.Top, ActiveRect.right, ActiveRect.bottom - BottomMargin); 
    SelectClipRgn (handle, region); 
    DeleteObject (region); 
 
    prevY := fPrevY; 
    MoveTo (0, prevY); 
    for n := 0 to fNoTempoChanges -1 do 
      with fTempoChangeMap [n] do 
      begin 
        if Selected then 
          Brush.Color := clSilver 
        else 
          Brush.Color := clwhite; 
        LineTo (fx, prevY); 
        LineTo (fx, fy); 
        Rectangle (fx - 3, fy - 3, fx + 3, fy + 3); 
        prevY := fy; 
      end; 
    LineTo (ActiveRect.Right, prevY); 
    Brush.Color := oldColor; 
  end 
end; 
 
procedure TTempoMap.SetMaxTempo(const Value: Integer); 
begin 
  if fMaxTempo <> Value then 
  begin 
    fMaxTempo := Value; 
    VertScrollBar.SetParams (VertScrollbar.Position, 0, fMaxTempo); 
    Refresh 
  end 
end; 
 
{ TTempoChange } 
 
procedure TTempoChange.Init(x, y: Integer; Event: PMidiEventData; 
  isSelected: boolean); 
begin 
  fx := x; 
  fy := y; 
  fEvent := Event; 
  selected := isSelected 
end; 
 
end.