cmptempomap.pas

Delphi的另一款钢琴软件

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 CalcBarMap; override;
    { Protected declarations }
  public
    constructor Create (AOwner : TComponent); override;
  published
    procedure DisplayBarMapContents; override;
    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.