⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fmnoteeditor.pas

📁 Delphi的另一款钢琴软件
💻 PAS
字号:
unit fmNoteEditor;

interface                           

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls, Forms, Dialogs,
  fmBar, cmpPianoRoll, Buttons, ExtCtrls, fmPower, cmpTimerSpeedButton,
  Menus, cmpKeyboard, cmpBarControl;

type
  TNoteEditorForm = class(TBarForm)
    PianoRoll1: TPianoRoll;
    Bevel1: TBevel;
    Keys1: TKeys;
    PopupMenu: TPopupMenu;
    InsertNote: TMenuItem;
    EditNote: TMenuItem;
    DeleteNote: TMenuItem;
    N1: TMenuItem;
    SelectTrack1: TMenuItem;
    stNote: TLabel;
    stFocusedNote: TLabel;
    stPosition: TLabel;
    procedure AdjustHeader;
    procedure FormShow(Sender: TObject);
    procedure LStretcherClick(Sender: TObject);
    procedure RStretcherClick(Sender: TObject);
    procedure PopupMenuPopup(Sender: TObject);
    procedure Keys1NoteOn(Sender: TObject; note, velocity: Integer);
    procedure Keys1NoteOff(Sender: TObject; note, velocity: Integer);
    procedure PianoRoll1Scroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure SelectTrack1Click(Sender: TObject);
    procedure DeleteNoteClick(Sender: TObject);
    procedure PianoRoll1NoteMoving(sender: TObject; note,
      startPos, endPos: Integer);
    procedure PianoRoll1NoteMoved(sender: TObject; note,
      startPos, endPos: Integer);
    procedure PianoRoll1StartSelection(sender: TObject; pos: Integer);
    procedure PianoRoll1EndSelection(sender: TObject; pos: Integer);
    procedure FormResize(Sender: TObject);
    procedure PianoRoll1Focus(Sender: TObject);
    procedure PianoRoll1MouseMoved(sender: TObject; bar, beat,
      tick: Integer);
  private
    MovingNotePlaying : Integer;
  protected
  public
    procedure Notify (tp : TActiveFormNotify); override;
  end;

implementation

{$R *.DFM}

//{$DEFINE POS_DISPLAY}

uses fmMainForm, unitMidiGlobals, cmpMidiIterator;

procedure TNoteEditorForm.Notify (tp : TactiveFormNotify);
begin
  inherited;
  with PianoRoll1 do
  begin
    SetSelStartPos (MainForm.SelStartPos, False);
    SetSelEndPos (MainForm.SelEndPos, False);
    ActivePosition := MainForm.CurrentPosition;
    if tp = ntFullUpdate then Refresh
  end
end;

procedure TNoteEditorForm.FormShow(Sender: TObject);
begin
  PianoRoll1.Track := MainForm.CurrentTrackNo;
  inherited;
  AdjustHeader;
  MovingNotePlaying := -1;
  SetCaption ('Note Editor', PianoRoll1.Track);
end;

procedure TNoteEditorForm.LStretcherClick(Sender: TObject);
begin
  inherited;
  PianoRoll1.QNWidth := PianoRoll1.QNWidth - 1;
end;

procedure TNoteEditorForm.RStretcherClick(Sender: TObject);
begin
  inherited;
  PianoRoll1.QNWidth := PianoRoll1.QNWidth + 1;
end;

procedure TNoteEditorForm.AdjustHeader;
begin
  Keys1.NoteWidth := PianoRoll1.WhiteNoteHeight;
  Keys1.top := PianoRoll1.Top - 1;
  Keys1.height := PianoRoll1.ActiveHeight + 2;
end;

procedure TNoteEditorForm.PopupMenuPopup(Sender: TObject);
begin
  inherited;
  DeleteNote.Enabled := PianoRoll1.NoteFocused;
  EditNote.Enabled := PianoRoll1.NoteFocused;

end;

procedure TNoteEditorForm.Keys1NoteOn(Sender: TObject; note,
  velocity: Integer);
begin
  inherited;
  with PianoRoll1 do if Assigned (MidiData) then
    MainForm.TrackOutputs.TrackOutput [Track].Port.NoteOn (MidiData.Tracks [Track].Channel, note, velocity);
end;

procedure TNoteEditorForm.Keys1NoteOff(Sender: TObject; note,
  velocity: Integer);
begin
  inherited;
  with PianoRoll1 do
    MainForm.TrackOutputs.TrackOutput [Track].Port.NoteOff (MidiData.Tracks [Track].Channel, note, velocity);
end;

procedure TNoteEditorForm.PianoRoll1Scroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  inherited;
  Keys1.BaseOctave := 11 - ScrollPos;
end;

procedure TNoteEditorForm.SelectTrack1Click(Sender: TObject);
var
  trackNo : Integer;
begin
  inherited;
  trackNo := PianoRoll1.Track;
  if MainForm.SelectTrackDialog (trackNo, False, False) then
  begin
    PianoRoll1.Track := trackNo;
    SetCaption ('Note Editor', PianoRoll1.Track);
  end
end;

procedure TNoteEditorForm.DeleteNoteClick(Sender: TObject);
var
   startIdx, endIdx : Integer;
   startNote : PMidiEventData;
begin
  inherited;
  with PianoRoll1 do if NoteFocused then with MidiData.Tracks [Track] do
  begin
    GetFocusedNote (startNote);
    with MidiData.Tracks [Track] do
    begin
      startIdx := IndexOf (startNote);
      endIdx := IndexOf (startNote^.OnOffEvent)
    end;
    DeleteEvent (endIdx);
    DeleteEvent (startIdx);
    MidiData.Tracks [Track].CalcOnOffPointers;
    MainForm.NotifyAll
  end
end;

procedure TNoteEditorForm.PianoRoll1NoteMoving(sender: TObject; note, startPos, endPos: Integer);
var
  velocity : Integer;
begin
  inherited;
  velocity := MainForm.DragNoteVolume;
  if velocity > 0 then with PianoRoll1 do if Assigned (MidiData) and (note <> MovingNotePlaying) then
  begin
    if MovingNotePlaying <> -1 then
      Keys1.ReleaseNote (MovingNotePlaying, 0, True);
    MovingNotePlaying := note;
    Keys1.PressNote (MovingNotePlaying, velocity, True);
  end
end;

procedure TNoteEditorForm.PianoRoll1NoteMoved(sender: TObject; note, startPos, endPos: Integer);
var
  se, ee : TEventData;
  sed, eed : PMidiEventData;
  endIDX, startIDX : Integer;
begin
  inherited;
  with PianoRoll1 do if Assigned (MidiData) then with MidiData.Tracks [Track] do
  begin
    if MovingNotePlaying <> -1 then
    begin
      Keys1.ReleaseNote (MovingNotePlaying, 0, True);
      MovingNotePlaying := -1
    end;

    GetFocusedNote (sed);
    eed := sed^.OnOffEvent;

    se := sed^.data;
    ee := eed^.data;

    with MidiData.Tracks [Track] do
    begin
      endIdx := IndexOf (eed);
      startIdx := IndexOf (sed)
    end;


    BeginUpdate;
    try
      DeleteEvent (endIdx);
      DeleteEvent (startIdx);

      se.b2 := Note;
      ee.b2 := Note;
      InsertEvent (startPos, se, 0);
      InsertEvent (endPos, ee, 0)
    finally
      EndUpdate
    end;
    MainForm.NotifyAll
  end
end;

procedure TNoteEditorForm.PianoRoll1StartSelection(sender: TObject;
  pos: Integer);
begin
  inherited;
  MainForm.SelStartPos := pos;
  MainForm.SelEndPos := 0;
  with PianoRoll1 do
  begin
    SetSelEndPos (MainForm.SelEndPos, True);
    SetSelStartPos (MainForm.SelStartPos, True)
  end
end;

procedure TNoteEditorForm.PianoRoll1EndSelection(sender: TObject;
  pos: Integer);
begin
  inherited;
  MainForm.SelEndPos := pos;
  PianoRoll1.SetSelEndPos (MainForm.SelEndPos, True);
end;

var
  alreadyMaxed : boolean = False;
  
procedure TNoteEditorForm.FormResize(Sender: TObject);
begin
  inherited;
  AdjustHeader;
  if WindowState = wsMaximized then
  begin
    if not alreadyMaxed then  // Work round maximize bug.
    begin
      Application.ProcessMessages;
      PianoRoll1.Invalidate;
      alreadyMaxed := True
    end
  end
  else
    AlreadyMaxed := False
end;

procedure TNoteEditorForm.PianoRoll1Focus(Sender: TObject);
var
 noteOnEvent : PMidiEventData;
 s : string;
 x : Integer;
 bar, beat, tick : Integer;
begin
  inherited;
  with PianoRoll1 do
    GetFocusedNote (noteOnEvent);

  if Assigned (noteOnEvent) and Assigned (noteOnEvent.OnOffEvent) then
  begin
    s := 'Off:';
    x := PianoRoll1.CalcPosX (noteOnEvent.OnOffEvent.Pos);
    PianoRoll1.CalcBarAndBeatFromXY (x, 0, bar, beat, tick);
    {$IFDEF POS_DISPLAY}
    stFocusedNote.Caption := IntToStr (noteOnEvent.OnOffEvent.Pos)
    {$ELSE}
    stFocusedNote.Caption := Format ('%s %d:%d:%d', [s, bar, beat, tick])
    {$ENDIF}
  end
  else
  begin
    stFocusedNote.Caption := '---';
  end
end;

procedure TNoteEditorForm.PianoRoll1MouseMoved(sender: TObject; bar,
  beat, tick: Integer);
var
  noteOnEvent : PMidiEventData;
  x : Integer;
  s : string;
begin
  inherited;
  stNote.Caption := GetNoteName (PianoRoll1.GetNoteNoAtCursor);
  with PianoRoll1 do
    GetFocusedNote (noteOnEvent);

  if Assigned (noteOnEvent) then
  begin
    s := 'On:';
    x := PianoRoll1.CalcPosX (noteOnEvent.Pos);
    PianoRoll1.CalcBarAndBeatFromXY (x, 0, bar, beat, tick);
    {$IFDEF POS_DISPLAY}
    stPosition.Caption := IntToStr (noteOnEvent.pos);
    {$ELSE}
    stPosition.Caption := Format ('%s %d:%d:%d', [s, bar, beat, tick]);
    {$ENDIF}
  end
  else
  begin
    s := 'Pos';
    stPosition.Caption := Format ('%s %d:%d:%d', [s, bar, beat, tick]);
  end;

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -