path: root/src/lib/midi/MidiScope.pas

{
  Shows a large black area where midi note/controller events are shown
  just to monitor midi activity (for the MidiPlayer)

  version 1.0 first release

  for comments/bugs
  F.Bouwmans
  fbouwmans@spiditel.nl

  if you think this component is nice and you use it, sent me a short email.
  I've seen that other of my components have been downloaded a lot, but I've
  got no clue wether they are actually used.
  Don't worry because you are free to use these components
}

unit MidiScope;

interface

{$IFDEF FPC}
  {$MODE Delphi}
  {$H+} // use long strings
{$ENDIF}

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

type
  TMidiScope = class(TGraphicControl)
  private
    { Private declarations }
  protected
    { Protected declarations }
    notes:       array[0..15,0..127] of integer;
    controllers: array[0..15,0..17]  of integer;
    aftertouch:  array[0..15,0..127] of integer;

    selectedChannel: integer;

    procedure PaintSlide(ch, pos, val: integer);

    procedure NoteOn(channel, note, speed: integer);
    procedure Controller(channel, number, value: integer);
    procedure AfterTch(channel, note, value: integer);

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure MidiEvent(event, data1, data2: integer);
    procedure Paint; override;
  published
    { Published declarations }
  end;

procedure Register;

const
  BarHeight     = 16;
  BarHeightInc  = BarHeight + 2;
  BarWidth      = 3;
  BarWidthInc   = BarWidth + 1;
  HeightDiv     = 128 div BarHeight;

implementation

uses
  MidiCons;

procedure Register;
begin
  RegisterComponents('Synth', [TMidiScope]);
end;

constructor TMidiScope.Create(AOwner: TComponent);
var
 i, j: integer;
begin
  inherited Create(AOwner);
  Height := BarHeightinc * 16 + 4;
  Width :=  147 * BarWidthInc + 4 + 20;  // for channel number
  for i := 0 to 15 do
    for j := 0 to 127 do
    begin
      notes[i,j] := 0;
      aftertouch[i,j] := 0;
    end;
  for i := 0 to 17 do
    for j := 0 to 15 do
      controllers[i,j] := 0;
end;

procedure TMidiScope.PaintSlide(ch, pos, val: integer);
var
  x, y:integer;
begin
  Canvas.Brush.Color := clBlack;
  Canvas.Pen.color := clBlack;
  x := pos * BarWidthInc + 2;
  y := 2 + ch * BarHeightInc;
  Canvas.Rectangle(x, y, x + BarWidthInc, y + BarHeightInc);
  Canvas.Brush.Color := clGreen;
  Canvas.Pen.Color := clGreen;
  Canvas.Rectangle(x, y + (BarHeight - (val div HeightDiv)), x + BarWidth, y + BarHeight)
end;

procedure TMidiScope.Paint;
var
  i, j: integer;
  x: integer;
begin
  Canvas.Brush.color := clBlack;
  Canvas.Rectangle(0, 0, Width, Height);
  Canvas.Pen.Color := clGreen;
  x := 128 * BarWidthInc + 2;
  Canvas.MoveTo(x, 0);
  Canvas.LineTo(x, Height);
  x := 148 * BarWIdthInc + 2;
  canvas.Font.Color := clGreen;
  for i := 0 to 15 do
    Canvas.TextOut(x, ((i + 1) * BarHeightInc) - Canvas.font.size - 3, IntToStr(i + 1));
  canvas.Pen.color := clBlack;
  for j := 0 to 127 do
    PaintSlide(i, j, notes[i,j]);
  for j := 0 to 17 do
    PaintSlide(i, j + 129, controllers[i,j]);
end;

procedure TMidiScope.NoteOn(channel, note, speed: integer);
begin
  notes[channel,note] := speed;
  PaintSlide(channel, note, notes[channel,note]);
end;

procedure TMidiScope.AfterTch(channel, note, value: integer);
begin
  aftertouch[channel,note] := value;
end;

procedure TMidiScope.Controller(channel, number, value: integer);
var
  i: integer;
begin
  if number < 18 then
  begin
    controllers[channel,number] := value;
    PaintSlide(channel, number + 129, value);
  end
  else if number >= $7B then
  begin
    // all notes of for channel
    for i := 0 to 127 do
      if notes[channel,i] > 0 then
      begin
        notes[channel,i] := 0;
        PaintSlide(channel, i, 0);
      end;
  end;
end;

procedure TMidiScope.MidiEvent(event, data1, data2: integer);
begin
  case (event and $F0) of
    MIDI_NOTEON :        NoteOn    ((event and $F), data1, data2);
    MIDI_NOTEOFF:        NoteOn    ((event and $F), data1, 0    );
    MIDI_CONTROLCHANGE:  Controller((event and $F), data1, data2);
    MIDI_CHANAFTERTOUCH: Controller((Event and $F), 16,    data1);
    MIDI_PITCHBEND:      Controller((Event and $F), 17,    data2);
    MIDI_KEYAFTERTOUCH: ;
  end;
end;

end.