cmpcontrollermap.pas

Delphi的另一款钢琴软件

unit cmpControllerMap;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  cmpBarControl, unitMidiGlobals;

const
  MaxControllerChanges = 512;

type
  TControllerChange = object
    fx, fy : Integer;
    fEvent : PMidiEventData;
    selected : boolean;
    procedure Init (x, y : Integer; Event : PMidiEventData; isSelected : boolean);
  end;

  TControllerMap = class(TBarControl)
  private
    fNoControllerChanges : Integer;
    fControllerChangeMap : array [0..MaxControllerChanges - 1] of TControllerChange;
    fPrevY : Integer;
    fController : TController;

    procedure SetController (value : TController);
  protected
    procedure CalcControllerMap;
    procedure DisplayBarMapContents; override;
    procedure CalcBarMap; override;
  public
    constructor Create (AOwner : TComponent); override;
  published
    property Controller : TController read fController write SetController;
  end;

procedure Register;

implementation

uses unitMidiTrackStream;

procedure Register;
begin
  RegisterComponents('MIDI', [TControllerMap]);
end;

{ TControllerMap }

procedure TControllerMap.CalcBarMap;
begin
  inherited;
  CalcControllerMap
end;

procedure TControllerMap.CalcControllerMap;
var
  p : PMidiEventData;
  i, idx, h : Integer;
  s : byte;
  Controller : Integer;
  prevController : Integer;

  procedure AddControllerChange (Controller : Integer; e : PMidiEventData);
  var
    x, y : Integer;
    selected : boolean;
  begin
    if fNoControllerChanges < MaxControllerChanges then
    begin
      with MidiData.Tracks [Track] do
      begin
        selected := (e^.pos >= SelStartPos) and (e^.pos <= SelEndPos);
        x := CalcPosX (e^.pos);
      end;
      y := h - (Controller + VertScrollbar.Position) * h  div 127 + h div 2;
      fControllerChangeMap [fNoControllerChanges].Init (x, y, e, selected);
      Inc (fNoControllerChanges)
    end
  end;

begin
  fNoControllerChanges := 0;
  h := ActiveRect.Bottom - BottomMargin;

  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;
  prevController := 0;
  while i >= 0 do
  begin
    Dec (i);
    if i < 0 then break;
    p := MidiData.Tracks [Track].Event [idx];
    s := p^.data.status and midiStatusMask;
    if (s = midiController) and (p^.data.b2 = fController) then
    begin
      prevController := p^.data.b3;
      break
    end
  end;

  fPrevY :=  h - (prevController + VertScrollbar.Position) * h div 127 + 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 and midiStatusMask;
    if (s = midiController) and (p^.data.b2 = fController) then
    begin
      Controller := p^.data.b3;
      AddControllerChange (Controller, p)
    end;
    Inc (idx);
  end
end;

constructor TControllerMap.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  VertScrollBar.LargeChange := 1;
  VertScrollBar.SetParams (63, 0, 127);
end;

procedure TControllerMap.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 fNoControllerChanges -1 do
      with fControllerChangeMap [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 TControllerMap.SetController(value: TController);
begin
  if fController <> value then
  begin
    fController := value;
    Refresh
  end
end;

{ TControllerChange }

procedure TControllerChange.Init(x, y: Integer; Event: PMidiEventData;
  isSelected: boolean);
begin
  fx := x;
  fy := y;
  fEvent := Event;
  selected := isSelected
end;

end.