Component

{
  untPianoRoll v1.0.0 - a simple pianoroll editor
  for Delphi 2010 - 10.4 by Ernst Reidinga
  https://erdesigns.eu

  This unit is part of the ERDesigns Midi Components Pack.

  (c) Copyright 2020 Ernst Reidinga <ernst@erdesigns.eu>

  Bugfixes / Updates:
  - Initial Release 1.0.0

  If you use this unit, please give credits to the original author;
  Ernst Reidinga.
}

unit untPianoRoll;

interface

uses
  System.SysUtils, System.Classes, Winapi.Windows, Vcl.Controls, Vcl.Graphics,
  Winapi.Messages, GDIPlus;

type
  TPianoRollItem = class(TCollectionItem)
  private
    FRow      : Integer;
    FCol      : Integer;
    FOffset   : Single;
    FLength   : Single;
    FColor    : TColor;
    FSelected : Boolean;
    FCaption  : TCaption;

    procedure SetRow(const I: Integer);
    procedure SetCol(const I: Integer);
    procedure SetOffset(const S: Single);
    procedure SetLength(const S: Single);
    procedure SetColor(const C: TColor);
    procedure SetSelected(const B: Boolean);
    procedure SetCaption(const C: TCaption);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(AOWner: TCollection); override;

    procedure Assign(Source: TPersistent); override;
  published
    property Row: Integer read FRow write SetRow default 0;
    property Col: Integer read FCol write SetCol default 0;
    property OffSet: Single read FOffset write SetOffset;
    property Length: Single read FLength write SetLength;
    property Color: TColor read FColor write SetColor default clNone;
    property Caption: TCaption read FCaption write SetCaption;
    property Selected: Boolean read FSelected write SetSelected;
  end;

  TPianoRollItems = class(TOwnedCollection)
  private
    FOnChange : TNotifyEvent;

    procedure ItemChanged(Sender: TObject);

    function GetItem(Index: Integer): TPianoRollItem;
    procedure SetItem(Index: Integer; const Value: TPianoRollItem);
  protected
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TPersistent);
    function Add: TPianoRollItem;
    procedure Assign(Source: TPersistent); override;

    property Items[Index: Integer]: TPianoRollItem read GetItem write SetItem;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TPianoRollNotes = class(TPersistent)
  private
    { Private declarations }
    FColor           : TColor;
    FToColor         : TColor;
    FSelectedColor   : TColor;
    FSelectedToColor : TColor;
    FLineColor       : TColor;
    FFont            : TFont;
    FShowCaptions    : Boolean;

    FOnChange   : TNotifyEvent;

    procedure SetColor(const C: TColor);
    procedure SetToColor(const C: TColor);
    procedure SetSelectedColor(const C: TColor);
    procedure SetSelectedToColor(const C: TColor);
    procedure SetLineColor(const C: TColor);
    procedure SetFont(const F: TFont);
    procedure SetShowCaptions(const B: Boolean);
  public
    { Public declarations }
    constructor Create; virtual;
    destructor Destroy; override;
  published
    { Published declarations }
    property Color: TColor read FColor write SetColor default $00C7F3C0;
    property ToColor: TColor read FToColor write SetToColor default $00A6D09E;
    property SelectedColor: TColor read FSelectedColor write SetSelectedColor default $009D9DFC;
    property SelectedToColor: TColor read FSelectedToColor write SetSelectedToColor default $008281DD;
    property LineColor: TColor read FLineColor write SetLineColor default $00433B3C;
    property Font: TFont read FFont write SetFont;
    property ShowCaptions: Boolean read FShowCaptions write SetShowCaptions default True;

    property OnChange: TNotifyEvent read FOnChange write FonChange;
  end;

  TPianoRollPositionIndicator = class(TPersistent)
  private
    { Private declarations }
    FHeight     : Integer;
    FWidth      : Integer;
    FColor      : TColor;
    FLineColor  : TColor;

    FOnChange   : TNotifyEvent;

    procedure SetHeight(const I: Integer);
    procedure SetWidth(const I: Integer);
    procedure SetColor(const C: TColor);
    procedure SetLineColor(const C: TColor);
  public
    { Public declarations }
    constructor Create; virtual;
  published
    { Published declarations }
    property Height: Integer read FHeight write SetHeight default 8;
    property Width: Integer read FWidth write SetWidth default 12;
    property Color: TColor read FColor write SetColor default $0067D7AE;
    property LineColor: TColor read FLineColor write SetLineColor default $0067D7AE;

    property OnChange: TNotifyEvent read FOnChange write FonChange;
  end;

  TPianoRollRuler = class(TPersistent)
  private
    { Private declarations }
    FHeight     : Integer;
    FColor      : TColor;
    FToColor    : TColor;
    FLineColor  : TColor;
    FFont       : TFont;
    FShowLines  : Boolean;
    FShowNumbers: Boolean;

    FOnChange   : TNotifyEvent;

    procedure SetHeight(const I: Integer);
    procedure SetColor(const C: TColor);
    procedure SetToColor(const C: TColor);
    procedure SetLineColor(const C: TColor);
    procedure SetFont(const F: TFont);
    procedure SetShowLines(const B: Boolean);
    procedure SetShowNumbers(const B: Boolean);
  public
    { Public declarations }
    constructor Create; virtual;
    destructor Destroy; override;
  published
    { Published declarations }
    property Height: Integer read FHeight write SetHeight default 32;
    property Color: TColor read FColor write SetColor default $00322A1D;
    property ToColor: TColor read FToColor write SetToColor default $00453C2F;
    property LineColor: TColor read FLineColor write SetLineColor default $00676456;
    property Font: TFont read FFont write SetFont;
    property ShowLines: Boolean read FShowLines write SetShowLines default False;
    property ShowNumbers: Boolean read FShowNumbers write SetShowNumbers default True;

    property OnChange: TNotifyEvent read FOnChange write FonChange;
  end;

  TPianoRollGrid = class(TPersistent)
  private
    { Private declarations }
    FColor1     : TColor;
    FColor2     : TColor;
    FLineColor1 : TColor;
    FLineColor2 : TColor;

    FOnChange   : TNotifyEvent;

    procedure SetColor1(const C: TColor);
    procedure SetColor2(const C: TColor);
    procedure SetLineColor1(const C: TColor);
    procedure SetLineColor2(const C: TColor);
  public
    { Public declarations }
    constructor Create; virtual;
  published
    { Published declarations }
    property Color1: TColor read FColor1 write SetColor1 default $004E4335;
    property Color2: TColor read FColor2 write SetColor2 default $00483E2D;
    property LineColor1: TColor read FLineColor1 write SetLineColor1 default $00231908;
    property LineColor2: TColor read FLineColor2 write SetLineColor2 default $0043382A;

    property OnChange: TNotifyEvent read FOnChange write FonChange;
  end;

  TPianoRollLoopBar = class(TPersistent)
  private
    { Private declarations }
    FStart     : Single;
    FStop      : Single;
    FColor     : TColor;
    FLineColor : TColor;

    FOnChange   : TNotifyEvent;

    procedure SetStart(const S: Single);
    procedure SetStop(const S: Single);
    procedure SetColor(const C: TColor);
    procedure SetLineColor(const C: TColor);
  public
    { Public declarations }
    constructor Create; virtual;
  published
    { Published declarations }
    property Start: Single read FStart write SetStart;
    property Stop: Single read FStop write SetStop;
    property Color: TColor read FColor write SetColor default $004A47CF;
    property LineColor: TColor read FLineColor write SetLineColor default $004A47CF;

    property OnChange: TNotifyEvent read FOnChange write FonChange;
  end;

  TPianoRollSelection = class(TPersistent)
  private
    { Private declarations }
    FColor     : TColor;
    FLineColor : TColor;

    FOnChange   : TNotifyEvent;

    procedure SetColor(const C: TColor);
    procedure SetLineColor(const C: TColor);
  public
    { Public declarations }
    constructor Create; virtual;
  published
    { Published declarations }
    property Color: TColor read FColor write SetColor default $004A47CF;
    property LineColor: TColor read FLineColor write SetLineColor default $004A47CF;

    property OnChange: TNotifyEvent read FOnChange write FonChange;
  end;


  TPianoRoll = class(TCustomControl)
  private
    { Private declarations }

    { Buffer - Avoid flickering }
    FBuffer           : TBitmap;
    FRulerBuffer      : TBitmap;
    FUpdateRect       : TRect;

    { Redraw part }
    FRedrawRuler: Boolean;

    { Scroll Positions and Max }
    FScrollPosX : Integer;
    FScrollPosY : Integer;
    FScrollMaxX : Integer;
    FScrollMaxY : Integer;
    FOldScrollX : Integer;
    FOldScrollY : Integer;

    { Selection }
    FIsSelecting : Boolean;
    FSelectFrom  : TPoint;
    FSelectTo    : TPoint;

    { Settings }
    FPositionIndicator  : TPianoRollPositionIndicator;
    FRuler              : TPianoRollRuler;
    FGrid               : TPianoRollGrid;
    FLoopBar            : TPianoRollLoopBar;
    FSelection          : TPianoRollSelection;
    FItems              : TPianoRollItems;
    FNotes              : TPianoRollNotes;

    { Zoom factor }
    FZoomHorizontal : Integer;
    FZoomVertical   : Integer;

    { Player position }
    FPlayerPosition : Single;

    { Rows and Columns }
    FMaxRows : Integer;
    FMaxCols : Integer;

    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;

    procedure SetScrollPosX(const I: Integer);
    procedure SetScrollPosY(const I: Integer);

    procedure SetItems(I: TPianoRollItems);

    procedure SetZoomHorizontal(const Z: Integer);
    procedure SetZoomVertical(const Z: Integer);

    procedure SetPlayerPosition(const S: Single);
    procedure SetMaxRows(const I: Integer);
    procedure SetMaxCols(const I: Integer);
  protected
    { Protected declarations }
    procedure SettingsChanged(Sender: TObject);

    procedure Paint; override;
    procedure Resize; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property UpdateRect: TRect read FUpdateRect write FUpdateRect;

    property RedrawRuler: Boolean read FRedrawRuler write FRedrawRuler;
  published
    { Published declarations }
    property PositionIndicator: TPianoRollPositionIndicator read FPositionIndicator;
    property Ruler: TPianoRollRuler read FRuler;
    property Grid: TPianoRollGrid read FGrid;
    property LoopBar: TPianoRollLoopBar read FLoopBar;
    property Selection: TPianoRollSelection read FSelection;
    property Items: TPianoRollItems read FItems write SetItems;
    property Notes: TPianoRollNotes read FNotes;

    property ZoomHorizontal: Integer read FZoomHorizontal write SetZoomHorizontal default 100;
    property ZoomVertical: Integer read FZoomVertical write SetZoomVertical default 100;

    property MaxRows: Integer read FMaxRows write SetMaxRows default 64;
    property MaxCols: Integer read FMaxCols write SetMaxCols default 32;

    property PlayerPosition: Single read FPlayerPosition write SetPlayerPosition;
  end;

procedure Register;

implementation

uses Math;

{ Zoom defaults }
const
  { Block width @ 100% zoom = 56px (div 4 = 14px per small block) }
  BlockWidth100 = 56;
  { Block height @ 100% zoom = 14px }
  BlockHeight100 = 14;

(******************************************************************************)
(*
(*  Piano Roll Collection Item (TPianoRollItem)
(*
(******************************************************************************)

constructor TPianoRollItem.Create(AOWner: TCollection);
begin
  inherited Create(AOwner);
  FColor   := clNone;
  FLength  := 1;
  FRow     := 1;
  FCol     := 1;
  FCaption := '';
end;

procedure TPianoRollItem.SetRow(const I: Integer);
begin
  if (I <> Row) then
  begin
    if (I > 0) then
      FRow := I
    else
      FRow := 1;
    Changed(False);
  end;
end;

procedure TPianoRollItem.SetCol(const I: Integer);
begin
  if I <> Col then
  begin
    if (I > 0) then
      FCol := I
    else
      FCol := 1;
    Changed(False);
  end;
end;

procedure TPianoRollItem.SetOffset(const S: Single);
begin
  if S <> OffSet then
  begin
    FOffSet := S;
    Changed(False);
  end;
end;

procedure TPianoRollItem.SetLength(const S: Single);
begin
  if S <> Length then
  begin
    FLength := S;
    Changed(False);
  end;
end;

procedure TPianoRollItem.SetColor(const C: TColor);
begin
  if C <> Color then
  begin
    FColor := C;
    Changed(False);
  end;
end;

procedure TPianoRollItem.SetSelected(const B: Boolean);
begin
  if B <> Selected then
  begin
    FSelected := B;
    Changed(False);
  end;
end;

procedure TPianoRollItem.SetCaption(const C: TCaption);
begin
  if C <> Caption then
  begin
    FCaption := C;
    Changed(False);
  end;
end;

function TPianoRollItem.GetDisplayName : string;
begin
  { Maybe change this to the corresponding notes ? }
  if (Caption <> '') then
    Result := Caption
  else
    Result := Format('Row %d - Col %d', [Row, Col]);
end;

procedure TPianoRollItem.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TPianoRollItem then
  begin
    Row    := TPianoRollItem(Source).Row;
    Col    := TPianoRollItem(Source).Col;
    OffSet := TPianoRollItem(Source).OffSet;
    Length := TPianoRollItem(Source).Length;
    Color  := TPianoRollItem(Source).Color;
    Changed(False);
  end else Inherited;
end;

(******************************************************************************)
(*
(*  Piano Roll Item Collection (TPianoRollItems)
(*
(******************************************************************************)
constructor TPianoRollItems.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TPianoRollItem);
end;

procedure TPianoRollItems.ItemChanged(Sender: TObject);
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TPianoRollItems.SetItem(Index: Integer; const Value: TPianoRollItem);
begin
  inherited SetItem(Index, Value);
  ItemChanged(Self);
end;

procedure TPianoRollItems.Update(Item: TCollectionItem);
begin
  inherited Update(Item);
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TPianoRollItems.GetItem(Index: Integer) : TPianoRollItem;
begin
  Result := inherited GetItem(Index) as TPianoRollItem;
end;

function TPianoRollItems.Add : TPianoRollItem;
begin
  Result := TPianoRollItem(inherited Add);
end;

procedure TPianoRollItems.Assign(Source: TPersistent);
var
  LI   : TPianoRollItems;
  Loop : Integer;
begin
  if (Source is TPianoRollItems)  then
  begin
    LI := TPianoRollItems(Source);
    Clear;
    for Loop := 0 to LI.Count - 1 do
        Add.Assign(LI.Items[Loop]);
  end else inherited;
end;

(******************************************************************************)
(*
(*  Piano Roll Notes (TPianoRollNotes)
(*
(******************************************************************************)
constructor TPianoRollNotes.Create;
begin
  inherited Create;
  FFont            := TFont.Create;
  FFont.OnChange   := FOnChange;
  FFont.Name       := 'Segoe UI';
  FFont.Color      := $00433B3C;
  FFont.Size       := 8;
  FColor           := $00C7F3C0;
  FToColor         := $00A6D09E;
  FSelectedColor   := $009D9DFC;
  FSelectedToColor := $008281DD;
  FLineColor       := $00433B3C;
  FShowCaptions    := True;
end;

destructor TPianoRollNotes.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TPianoRollNotes.SetColor(const C: TColor);
begin
  if C <> Color then
  begin
    FColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollNotes.SetToColor(const C: TColor);
begin
  if C <> ToColor then
  begin
    FToColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollNotes.SetSelectedColor(const C: TColor);
begin
  if C <> SelectedColor then
  begin
    FSelectedColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollNotes.SetSelectedToColor(const C: TColor);
begin
  if C <> SelectedToColor then
  begin
    FSelectedToColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollNotes.SetLineColor(const C: TColor);
begin
  if C <> LineColor then
  begin
    FLineColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollNotes.SetFont(const F: TFont);
begin
  FFont.Assign(F);
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TPianoRollNotes.SetShowCaptions(const B: Boolean);
begin
  if B <> ShowCaptions then
  begin
    FShowCaptions := B;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

(******************************************************************************)
(*
(*  Piano Roll Position Indicator (TPianoRollPositionIndicator)
(*
(******************************************************************************)

constructor TPianoRollPositionIndicator.Create;
begin
  inherited Create;
  FHeight    := 8;
  FWidth     := 12;
  FColor     := $0067D7AE;
  FLineColor := $0067D7AE;
end;

procedure TPianoRollPositionIndicator.SetHeight(const I: Integer);
begin
  if I <> FHeight then
  begin
    FHeight := I;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollPositionIndicator.SetWidth(const I: Integer);
begin
  if I <> FWidth then
  begin
    FWidth := I;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollPositionIndicator.SetColor(const C: TColor);
begin
  if C <> FColor then
  begin
    FColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollPositionIndicator.SetLineColor(const C: TColor);
begin
  if C <> FLineColor then
  begin
    FLineColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

(******************************************************************************)
(*
(*  Piano Roll Ruler (TPianoRollRuler)
(*
(******************************************************************************)

constructor TPianoRollRuler.Create;
begin
  inherited Create;
  FFont          := TFont.Create;
  FFont.OnChange := FOnChange;
  FFont.Color    := $00676456;
  FFont.Name     := 'Segoe UI';
  FHeight        := 32;
  FColor         := $00322A1D;
  FToColor       := $00453C2F;
  FLineColor     := $00676456;
  FShowLines     := False;
  FShowNumbers   := True;
end;

destructor TPianoRollRuler.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TPianoRollRuler.SetHeight(const I: Integer);
begin
  if I <> FHeight then
  begin
    FHeight := I;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollRuler.SetColor(const C: TColor);
begin
  if C <> FColor then
  begin
    FColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollRuler.SetToColor(const C: TColor);
begin
  if C <> FToColor then
  begin
    FToColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollRuler.SetLineColor(const C: TColor);
begin
  if C <> FLineColor then
  begin
    FLineColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollRuler.SetFont(const F: TFont);
begin
  if F <> FFont then
  begin
    FFont.Assign(F);
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollRuler.SetShowLines(const B: Boolean);
begin
  if B <> FShowLines then
  begin
    FShowLines := B;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollRuler.SetShowNumbers(const B: Boolean);
begin
  if B <> FShowNumbers then
  begin
    FShowNumbers := B;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

(******************************************************************************)
(*
(*  Piano Roll Grid (TPianoRollGrid)
(*
(******************************************************************************)

constructor TPianoRollGrid.Create;
begin
  inherited Create;
  FColor1     := $004E4335;
  FColor2     := $00483E2D;
  FLineColor1 := $00231908;
  FLineColor2 := $0043382A;
end;

procedure TPianoRollGrid.SetColor1(const C: TColor);
begin
  if C <> FColor1 then
  begin
    FColor1 := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollGrid.SetColor2(const C: TColor);
begin
  if C <> FColor2 then
  begin
    FColor2 := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollGrid.SetLineColor1(const C: TColor);
begin
  if C <> FLineColor1 then
  begin
    FLineColor1 := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollGrid.SetLineColor2(const C: TColor);
begin
  if C <> FLineColor2 then
  begin
    FLineColor2 := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

(******************************************************************************)
(*
(*  Piano Roll Loop Bar (TPianoRollLoopBar)
(*
(******************************************************************************)

constructor TPianoRollLoopBar.Create;
begin
  inherited Create;
  FStart     := 0;
  FStop      := 0;
  FColor     := $004A47CF;
  FLineColor := $004A47CF;
end;

procedure TPianoRollLoopBar.SetStart(const S: Single);
begin
  if S <> FStart then
  begin
    if FStop < S then
      FStart := FStop
    else
      FStart := S;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollLoopBar.SetStop(const S: Single);
begin
  if S <> FStop then
  begin
    if S < FStart then
      FStop := FStart
    else
      FStop := S;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollLoopBar.SetColor(const C: TColor);
begin
  if C <> FColor then
  begin
    FColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollLoopBar.SetLineColor(const C: TColor);
begin
  if C <> FLineColor then
  begin
    FLineColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

(******************************************************************************)
(*
(*  Piano Roll Selection (TPianoRollSelection)
(*
(******************************************************************************)

constructor TPianoRollSelection.Create;
begin
  inherited Create;
  FColor     := $004A47CF;
  FLineColor := $004A47CF;
end;

procedure TPianoRollSelection.SetColor(const C: TColor);
begin
  if C <> FColor then
  begin
    FColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TPianoRollSelection.SetLineColor(const C: TColor);
begin
  if C <> FLineColor then
  begin
    FLineColor := C;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

(******************************************************************************)
(*
(*  Piano Roll (TPianoRoll)
(*
(******************************************************************************)

constructor TPianoRoll.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  { If the ControlStyle property includes csOpaque, the control paints itself
    directly. We dont want the control to accept controls - but this might
    change in the future so we leave it here commented out. offcourse we
    like to get click, double click and mouse events. }
  ControlStyle := ControlStyle + [csOpaque{, csAcceptsControls},
    csCaptureMouse, csClickEvents, csDoubleClicks];

  { Create persistent classes }
  FPositionIndicator := TPianoRollPositionIndicator.Create;
  FPositionIndicator.OnChange := SettingsChanged;
  FRuler := TPianoRollRuler.Create;
  FRuler.OnChange := SettingsChanged;
  FGrid := TPianoRollGrid.Create;
  FGrid.OnChange := SettingsChanged;
  FLoopBar := TPianoRollLoopBar.Create;
  FLoopBar.OnChange := SettingsChanged;
  FSelection := TPianoRollSelection.Create;
  FSelection.OnChange := SettingsChanged;
  FItems := TPianoRollItems.Create(Self);
  FItems.OnChange := SettingsChanged;
  FNotes := TPianoRollNotes.Create;
  FNotes.OnChange := SettingsChanged;

  { Create Buffers }
  FBuffer := TBitmap.Create;
  FBuffer.PixelFormat := pf32bit;
  FRulerBuffer := TBitmap.Create;
  FRulerBuffer.PixelFormat := pf32bit;

  { Zoomfactor }
  FZoomHorizontal := 100;
  FZoomVertical   := 100;

  { Max Rows, Cols }
  MaxRows := 64;
  MaxCols := 32;

  { Initial Repaint }
  RedrawRuler             := True;
end;

destructor TPianoRoll.Destroy;
begin
  { Free Buffers }
  FBuffer.Free;
  FRulerBuffer.Free;

  { Free Persistent classes }
  FPositionIndicator.Free;
  FRuler.Free;
  FGrid.Free;
  FSelection.Free;
  FItems.Free;
  FNotes.Free;
  inherited Destroy;
end;

procedure TPianoRoll.WMPaint(var Msg: TWMPaint);
begin
  GetUpdateRect(Handle, FUpdateRect, False);
  inherited;
end;

procedure TPianoRoll.SetZoomHorizontal(const Z: Integer);
begin
  if Z <> FZoomHorizontal then
  begin
    if (Z < 50) then
      FZoomHorizontal := 50
    else
    begin
      FZoomHorizontal := Z;
      RedrawRuler := True;
      Invalidate;
    end;
  end;
end;

procedure TPianoRoll.SetZoomVertical(const Z: Integer);
begin
  if Z <> FZoomVertical then
  begin
    if (Z < 50) then
       FZoomVertical := 50
    else
    begin
      FZoomVertical := Z;
      Invalidate;
    end;
  end;
end;

procedure TPianoRoll.SetPlayerPosition(const S: Single);
begin
  if (S >= 0) then
  begin
    FPlayerPosition := S;
    Invalidate;
  end;
end;

procedure TPianoRoll.SetMaxRows(const I: Integer);
begin
  if (I <> MaxRows) then
  begin
    RedrawRuler := True;
    FMaxRows := I;
    Invalidate;
  end;
end;

procedure TPianoRoll.SetMaxCols(const I: Integer);
begin
  if (I <> MaxCols) then
  begin
    RedrawRuler  := True;
    FMaxCols := I;
    Invalidate;
  end;
end;


procedure TPianoRoll.SettingsChanged(Sender: TObject);
begin
  { Settings changed - repaint }
  RedrawRuler := True;
  Invalidate;
end;

procedure TPianoRoll.WMEraseBkGnd(var Msg: TWMEraseBkgnd);
begin
  { Draw Buffer to the Control }
  BitBlt(Msg.DC, 0, 0, ClientWidth, ClientHeight, FBuffer.Canvas.Handle, 0, 0, SRCCOPY);
  Msg.Result := -1;
end;

procedure TPianoRoll.SetScrollPosX(const I: Integer);
begin
  FScrollPosX := I;
  FScrollPosX := EnsureRange(FScrollPosX, 0, FScrollMaxX);
  FRedrawRuler := True;
  if FOldScrollX <> FScrollPosX then Invalidate;
  FOldScrollX := FScrollPosX;
end;

procedure TPianoRoll.SetScrollPosY(const I: Integer);
begin
  FScrollPosY := I;
  FScrollPosY := EnsureRange(FScrollPosY, 0, FScrollMaxY);
  FRedrawRuler := True;
  if FOldScrollY <> FScrollPosY then Invalidate;
  FOldScrollY := FScrollPosY;
end;

procedure TPianoRoll.SetItems(I: TPianoRollItems);
begin
  FItems.Assign(I);
  Invalidate;
end;

procedure TPianoRoll.Paint;
var
  HBlockSize  : Single;
  VBlockSize  : Integer;
  VisibleRows : Integer;
  VisibleCols : Integer;
  SubColWidth : Integer;

  procedure RepaintRuler;
  var
    FClientRect    : TGPRect;
    FGraphics      : IGPGraphics;
    FSolidBrush    : IGPSolidBrush;
    FFontBrush     : IGPSolidBrush;
    FGradientBrush : IGPLinearGradientBrush;
    FPen           : IGPPen;
    FFont          : TGPFont;
    FFontRect      : TGPRectF;
  var
    I, C, X, T : Integer;
  begin
    RedrawRuler := False;
    FRulerBuffer.SetSize(ClientWidth, Ruler.Height);
    FGraphics := TGPGraphics.Create(FRulerBuffer.Canvas.Handle);
    FGraphics.SmoothingMode     := SmoothingModeAntiAlias;
    FGraphics.InterpolationMode := InterpolationModeHighQualityBicubic;
    { Draw Ruler background }
    FClientRect := TGPRect.Create(0, 0, FRulerBuffer.Width, FRulerBuffer.Height);
    if Ruler.ToColor <> clNone then
    begin
      FGradientBrush := TGPLinearGradientBrush.Create(FClientRect,
        TGPColor.CreateFromColorRef(Ruler.Color),
        TGPColor.CreateFromColorRef(Ruler.ToColor), 90);
      FGraphics.FillRectangle(FGradientBrush, FClientRect);
    end else
    begin
      FSolidBrush := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(Ruler.Color));
      FGraphics.FillRectangle(FSolidBrush, FClientRect);
    end;
    { Draw ruler outline }
    FClientRect.Width  := FClientRect.Width - 1;
    FClientRect.Height := FClientRect.Height -1;
    FPen := TGPPen.Create(TGPColor.CreateFromColorRef(Ruler.LineColor));
    FPen.Alignment := PenAlignmentInset;
    FGraphics.DrawRectangle(FPen, FClientRect);
    { Draw ruler lines }
    if Ruler.ShowLines then
    begin
      T := Ceil(Ruler.Height / 2);
      for I := 0 to Ceil(ClientWidth / HBlockSize) do
      FGraphics.DrawLine(FPen, I * HBlockSize, T, I * HBlockSize, FClientRect.Bottom);
    end;
    { Draw ruler numbers }
    if Ruler.ShowNumbers then
    begin
      FFontBrush := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(Ruler.Font.Color));
      FFont      := TGPFont.Create(Ruler.Font.Name, Ruler.Font.Size, [{FontStyleBold}]);
      FFontRect  := FGraphics.MeasureString('123456789', FFont, TGPPointF.Create(0, 0));
      T := Ceil(FClientRect.Height - (FFontRect.Height +2));
      C := 0;
      for I := 0 to Ceil(ClientWidth / (SubColWidth * 4)) do if (I mod 4) = 0 then
      begin
        Inc(C);
        FGraphics.DrawString(IntToStr(C), FFont, TGPPointF.Create((I * (SubColWidth * 4)) +2, T), FFontBrush);
      end;
    end;
  end;

  procedure RepaintPositionIndicator;
  var
    FGraphics      : IGPGraphics;
    FSolidBrush    : IGPSolidBrush;
    FPen           : IGPPen;
    FLineFade      : TGPColor;
    FLineFadePen   : IGPPen;
  var
    I, P : Integer;
  begin
    FGraphics := TGPGraphics.Create(FBuffer.Canvas.Handle);
    FGraphics.SmoothingMode     := SmoothingModeAntiAlias;
    FGraphics.InterpolationMode := InterpolationModeHighQualityBicubic;
    FSolidBrush := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(PositionIndicator.Color));
    P := Round((PlayerPosition -1) * ((SubColWidth * 4) * 4));
    if (PlayerPosition > 0) then
    begin
      FPen := TGPPen.Create(TGPColor.CreateFromColorRef(PositionIndicator.LineColor));
      FPen.Alignment := PenAlignmentInset;
      FGraphics.DrawLine(FPen, P, Ruler.Height, P, ClientHeight);
      FLineFade := TGPColor.CreateFromColorRef(PositionIndicator.LineColor);
      for I := 1 to 6 do
      begin
        FLineFade.Alpha := 30 - (I *3);
        FLineFadePen := TGPPen.Create(FLineFade, I);
        FlineFadePen.LineJoin := LineJoinRound;
        FGraphics.DrawLine(FLineFadePen, (P +1) - I, Ruler.Height, (P +1) - I, ClientHeight -1);
      end;
    end;
    FGraphics.FillPolygon(FSolidBrush, [
      TGPPoint.Create(P, 1 + PositionIndicator.Height),
      TGPPoint.Create(P + Round(PositionIndicator.Width / 2), 1),
      TGPPoint.Create(P - Round(PositionIndicator.Width / 2), 1)
    ]);
  end;

  procedure RepaintLoopBar;
  var
    FGraphics      : IGPGraphics;
    FBrushColor    : TGPColor;
    FSolidBrush    : IGPSolidBrush;
    FPen           : IGPPen;
    FLineFadePen   : IGPPen;
    FLoopRect      : TGPRect;
  var
    S, E : Integer;
  begin
    FGraphics := TGPGraphics.Create(FBuffer.Canvas.Handle);
    FGraphics.SmoothingMode     := SmoothingModeAntiAlias;
    FGraphics.InterpolationMode := InterpolationModeHighQualityBicubic;
    FBrushColor := TGPColor.CreateFromColorRef(LoopBar.Color);
    FBrushColor.Alpha := 125;
    FSolidBrush := TGPSolidBrush.Create(FBrushColor);
    FPen := TGPPen.Create(TGPColor.CreateFromColorRef(LoopBar.LineColor));
    FPen.Alignment := PenAlignmentInset;
    S := Round((LoopBar.Start -1) * (HBlockSize * 4));
    E := Round((LoopBar.Stop -1) * (HBlockSize * 4));
    FLoopRect := TGPRect.Create(S, 1, E - S, Ruler.Height -3);
    FGraphics.FillRectangle(FSolidBrush, FLoopRect);
    FGraphics.DrawRectangle(FPen, FLoopRect);
  end;

  procedure DrawGrid;
  var
    FClientRect  : TGPRect;
    FRowRect     : TGPRect;
    FGraphics    : IGPGraphics;
    FSolidBrush1 : IGPSolidBrush;
    FSolidBrush2 : IGPSolidBrush;
    FPen1        : IGPPen;
    FPen2        : IGPPen;
    FPen3        : IGPPen;
  var
    X, Y, XI, YI : Integer;
  begin
    FGraphics := TGPGraphics.Create(FBuffer.Canvas.Handle);
    FGraphics.SmoothingMode     := SmoothingModeAntiAlias;
    FGraphics.InterpolationMode := InterpolationModeHighQualityBicubic;
    FClientRect := TGPRect.Create(0, 0, ClientWidth, ClientHeight);
    { Create brushes and pens }
    FSolidBrush1 := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(Grid.Color1));
    FSolidBrush2 := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(Grid.Color2));
    FPen1        := TGPPen.Create(TGPColor.CreateFromColorRef(Grid.LineColor1));
    FPen2        := TGPPen.Create(TGPColor.CreateFromColorRef(Grid.LineColor2));
    FPen3        := TGPPen.Create(TGPColor.CreateFromColorRef(Grid.LineColor1), 2);
    { Draw Horizontal Rows }
    for YI := 0 to Ceil(FClientRect.Height / VBlockSize) do
    begin
      FRowRect := TGPRect.Create(0, Ruler.Height + (YI * VBlockSize), FClientRect.Width, VBlockSize);
      if Odd(YI) then
        FGraphics.FillRectangle(FSolidBrush2, FRowRect)
      else
        FGraphics.FillRectangle(FSolidBrush1, FRowRect);
    end;

    { Draw Grid Horizontal }
    for YI := 0 to Ceil(FClientRect.Height / VBlockSize) do
    begin
      if (YI mod 4) = 0 then
        FGraphics.DrawLine(FPen1, 0, Ruler.Height + (YI * VBlockSize), ClientWidth, Ruler.Height + (YI * VBlockSize))
      else
        FGraphics.DrawLine(FPen2, 0, Ruler.Height + (YI * VBlockSize), ClientWidth, Ruler.Height + (YI * VBlockSize));
    end;

    { Draw Grid Vertical }
    for XI := 0 to Ceil(FClientRect.Width / SubColWidth) do
    begin
      if (XI mod 16) = 0 then
        FGraphics.DrawLine(FPen3, (XI * SubColWidth), Ruler.Height, (XI * SubColWidth), ClientHeight)
      else
      if (XI mod 4) = 0 then
        FGraphics.DrawLine(FPen1, (XI * SubColWidth), Ruler.Height, (XI * SubColWidth), ClientHeight)
      else
        FGraphics.DrawLine(FPen2, (XI * SubColWidth), Ruler.Height, (XI * SubColWidth), ClientHeight);
    end;
  end;

  procedure DrawItems;
  var
    FGraphics  : IGPGraphics;
    FPen       : IGPPen;
    FFontBrush : IGPSolidBrush;
    FFont      : TGPFont;

    procedure DrawNote(const Brush: IGPBrush; const Caption: string; const Rect: TGPRectF);
    begin
      FGraphics.FillRectangle(Brush, Rect);
      FGraphics.DrawRectangle(FPen, Rect);
      //if (Caption <> '') then
      //FGraphics.DrawString('Caption', FFont, Rect, TGPStringFormat.GenericDefault, FFontBrush);
    end;

  var
    FSolidBrush1    : IGPSolidBrush;
    FSolidBrush2    : IGPSolidBrush;
    FSolidBrush3    : IGPSolidBrush;
    FGradientBrush1 : IGPLinearGradientBrush;
    FGradientBrush2 : IGPLinearGradientBrush;
    FNoteRect       : TGPRectF;
  var
    I : Integer;
    B : Integer;
  begin
    FGraphics := TGPGraphics.Create(FBuffer.Canvas.Handle);
    FGraphics.SmoothingMode     := SmoothingModeAntiAlias;
    FGraphics.InterpolationMode := InterpolationModeHighQualityBicubic;
    { Grid is subdivided in 4 parts - 4X4 }
    B := (SubColWidth * 4) * 4;
    { Create solid brushes and pen }
    FSolidBrush1 := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(Notes.Color));
    FSolidBrush2 := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(Notes.SelectedColor));
    FPen         := TGPPen.Create(TGPColor.CreateFromColorRef(Notes.LineColor));
    { Create gradient brushes }
    FNoteRect := TGPRectF.Create(0, Ruler.Height, ClientWidth, VBlockSize);
    FGradientBrush1 := TGPLinearGradientBrush.Create(FNoteRect,
      TGPColor.CreateFromColorRef(Notes.Color),
      TGPColor.CreateFromColorRef(Notes.ToColor), 90);
    FGradientBrush2 := TGPLinearGradientBrush.Create(FNoteRect,
      TGPColor.CreateFromColorRef(Notes.SelectedColor),
      TGPColor.CreateFromColorRef(Notes.SelectedToColor), 90);
    { Create font }
    FFontBrush := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(Notes.Font.Color));
    FFont      := TGPFont.Create(Notes.Font.Name, Notes.Font.Size, [{FontStyleBold}]);
    { Draw Notes }
    for I := 0 to Items.Count -1 do
    begin
      { Check if the note is in the visible area - edit this according to scroll pos }
      if (Items.Items[I].Row <= VisibleRows) and (Items.Items[I].Col <= VisibleCols) then
      begin
        FNoteRect := TGPRectF.Create(
          ((Items.Items[I].Col -1) * B) + (Items.Items[I].OffSet * B),
           Ruler.Height + ((Items.Items[I].Row -1) * VBlockSize),
           Items.Items[I].Length * B,
           VBlockSize
          );
        { Check if the note is selected }
        if Items.Items[I].Selected then
        begin
          if (Notes.SelectedToColor = clNone) then
            DrawNote(FSolidBrush2, Items.Items[I].Caption, FNoteRect)
          else
            DrawNote(FGradientBrush2, Items.Items[I].Caption, FNoteRect);
        end else
        { Custom color? }
        if (Items.Items[I].Color <> clNone) then
        begin
          FSolidBrush3 := TGPSolidBrush.Create(TGPColor.CreateFromColorRef(Items.Items[I].Color));
          DrawNote(FSolidBrush3, Items.Items[I].Caption, FNoteRect);
        end else
        { Draw normal }
        begin
          if (Notes.ToColor = clNone) then
            DrawNote(FSolidBrush1, Items.Items[I].Caption, FNoteRect)
          else
            DrawNote(FGradientBrush1, Items.Items[I].Caption, FNoteRect);
        end;
      end;
    end;
  end;

  procedure DrawSelectionFrame;
  var
    FGraphics   : IGPGraphics;
    FSolidBrush : IGPSolidBrush;
    FPen        : IGPPen;
    FBrushColor : TGPColor;
    FSelectRect : TGPRect;
  begin
    FGraphics := TGPGraphics.Create(FBuffer.Canvas.Handle);
    FGraphics.SmoothingMode     := SmoothingModeAntiAlias;
    FGraphics.InterpolationMode := InterpolationModeHighQualityBicubic;
    FBrushColor := TGPColor.CreateFromColorRef(Selection.Color);
    FBrushColor.Alpha := 100;
    FSolidBrush := TGPSolidBrush.Create(FBrushColor);
    FPen        := TGPPen.Create(TGPColor.CreateFromColorRef(Selection.LineColor));
    FSelectRect := TGPRect.Create(FSelectFrom.X, FSelectFrom.Y, FSelectTo.X - FSelectFrom.X, FSelectTo.Y - FSelectFrom.Y);
    FGraphics.FillRectangle(FSolidBrush, FSelectRect);
    FGraphics.DrawRectangle(FPen, FSelectRect);
  end;

var
  X, Y, W, H : Integer;
  SI         : TScrollInfo;
begin
  if not Assigned(FBuffer) then Exit;

  { Horizontal block size - calculate it here so we can use it for drawing the
    rulerbar, but also for drawing the grid and the tones }
  HBlockSize := (ZoomHorizontal * (BlockWidth100 / 100));
  { Vertical block size - height of the bars }
  VBlockSize := Round(ZoomVertical * (BlockHeight100 / 100));
  { Calculate width (4x4 grid) }
  SubColWidth  := Ceil(HBlockSize / 4);

  { Set Max Scrollbar }
  if (HBlockSize * MaxCols) > ClientWidth then
    FScrollMaxX := Round(HBlockSize * MaxCols)
  else
    FScrollMaxX := ClientWidth;
  if (VBlockSize * MaxRows) > (ClientHeight - Ruler.Height) then
    FScrollMaxY := (VBlockSize * MaxRows) + Ruler.Height
  else
    FScrollMaxY := ClientHeight;

  { Calculate visible rows and columns }
  VisibleRows := Ceil(ClientHeight / VBlockSize);
  VisibleCols := Ceil(ClientWidth / HBlockSize);

  { Set Buffer size }
  FBuffer.SetSize(ClientWidth, ClientHeight);

  { Ruler }
  if RedrawRuler then RepaintRuler;

  { Draw everything to the buffer }
  DrawGrid;
  BitBlt(FBuffer.Canvas.Handle, ClientRect.Left, ClientRect.Top, ClientWidth, Ruler.Height,
    FRulerBuffer.Canvas.Handle, 0,  0, SRCCOPY);
  RepaintLoopBar;
  RepaintPositionIndicator;
  DrawItems;

  { Do we want a selectionframe? }
  if FIsSelecting then DrawSelectionFrame;

  { Now draw the Buffer to the components surface }
  X := UpdateRect.Left;
  Y := UpdateRect.Top;
  W := UpdateRect.Right - UpdateRect.Left;
  H := UpdateRect.Bottom - UpdateRect.Top;
  if (W <> 0) and (H <> 0) then
    { Only update part - invalidated }
    BitBlt(Canvas.Handle, X, Y, W, H, FBuffer.Canvas.Handle, X,  Y, SRCCOPY)
  else
    { Repaint the whole buffer to the surface }
    BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, FBuffer.Canvas.Handle, X,  Y, SRCCOPY);

  { Vertical Scrollbar }
  SI.cbSize := Sizeof(SI);
  SI.fMask  := SIF_ALL;
  SI.nMin   := 0;
  SI.nMax   := FScrollMaxY;
  SI.nPage  := 100;
  SI.nPos   := FScrollPosY;
  SI.nTrackPos := SI.nPos;
  SetScrollInfo(Handle, SB_VERT, SI, True);

  { Horizontal Scrollbar }
  SI.cbSize := Sizeof(SI);
  SI.fMask  := SIF_ALL;
  SI.nMin   := 0;
  SI.nMax   := FScrollMaxX;
  SI.nPage  := 100;
  SI.nPos   := FScrollPosX;
  SI.nTrackPos := SI.nPos;
  SetScrollInfo(Handle, SB_HORZ, SI, True);
end;

procedure TPianoRoll.Resize;
begin
  RedrawRuler := True;
end;

procedure TPianoRoll.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style or WS_HSCROLL or WS_VSCROLL and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TPianoRoll.WndProc(var Message: TMessage);
var
  SI : TScrollInfo;
begin
  inherited;
  case Message.Msg of
    // Capture Keystrokes
    WM_GETDLGCODE:
      Message.Result := Message.Result or DLGC_WANTARROWS or DLGC_WANTALLKEYS;

    // Horizontal Scrollbar
    WM_HSCROLL:
      begin
        case Message.WParamLo of
          SB_LEFT      : SetScrollPosX(0);
          SB_RIGHT     : SetScrollPosX(FScrollMaxX);
          SB_LINELEFT  : SetScrollPosX(FScrollPosX - 10);
          SB_LINERIGHT : SetScrollPosX(FScrollPosX + 10);
          SB_PAGELEFT  : SetScrollPosX(FScrollPosX - ClientWidth);
          SB_PAGERIGHT : SetScrollPosY(FScrollPosX + ClientWidth);
          SB_THUMBTRACK:
            begin
              ZeroMemory(@SI, SizeOf(SI));
              SI.cbSize := Sizeof(SI);
              SI.fMask := SIF_TRACKPOS;
              if GetScrollInfo(Handle, SB_HORZ, SI) then
                SetScrollPosX(SI.nTrackPos);
            end;
        end;
        Message.Result := 0;
      end;

    // Vertical Scrollbar
    WM_VSCROLL:
      begin
        case Message.WParamLo of
          SB_TOP      : SetScrollPosY(0);
          SB_BOTTOM   : SetScrollPosY(FScrollMaxY);
          SB_LINEUP   : SetScrollPosY(FScrollPosY - 10);
          SB_LINEDOWN : SetScrollPosY(FScrollPosY + 10);
          SB_PAGEUP   : SetScrollPosY(FScrollPosY - ClientHeight);
          SB_PAGEDOWN : SetScrollPosY(FScrollPosY + ClientHeight);
          SB_THUMBTRACK:
            begin
              ZeroMemory(@SI, SizeOf(SI));
              SI.cbSize := Sizeof(SI);
              SI.fMask := SIF_TRACKPOS;
              if GetScrollInfo(Handle, SB_VERT, SI) then
                SetScrollPosY(SI.nTrackPos);
            end;
        end;
        Message.Result := 0;
      end;

  end;
end;

function TPianoRoll.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
begin
  if (ssCtrl in Shift) then ZoomHorizontal := ZoomHorizontal + (WheelDelta div 10)
  else
  begin
    if (ssShift in Shift) then
      SetScrollPosX(FScrollPosX - (WheelDelta div 10))
    else
      SetScrollPosY(FScrollPosY - (WheelDelta div 10));
  end;
  Result := True;
end;

procedure TPianoRoll.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    { Check if we are selecting a note }

    { If no note is selected then we want to show a selection frame }
    FSelectFrom  := Point(X, Y);
    FSelectTo    := Point(X, Y);
    FIsSelecting := True;
  end;
  inherited;
end;

procedure TPianoRoll.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if FIsSelecting then
  begin
    FIsSelecting := False;
    Invalidate;
  end;
  inherited;
end;

procedure TPianoRoll.MouseMove(Shift: TShiftState; X: Integer; Y: Integer);
begin
  if FIsSelecting then
  begin
    FSelectTo := Point(X, Y);
    Invalidate;
  end;
  inherited;
end;

(******************************************************************************)
(*
(*  Register Piano Roll Componens (TPianoRoll)
(*
(*  note: Move this part to a serpate register unit!
(*
(******************************************************************************)

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

end.