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

📄 fmmainform.pas

📁 Delphi的另一款钢琴软件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    BtnStop.Down := True
  end
end;

//==========================================================================
// MIDI controls event handlers

(*-------------------------------------------------------------------------*
 | procedure TMainForm.UpdateTimerTimer                                    |
 |                                                                         |
 | Respond to an Update Timer event.  Get the current position from the    |
 | MIDI player, and update the display.                                    |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.UpdateTimerTimer(Sender: TObject);
begin
  DisplayCurrentPosition;
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.MidiPlayerCallback                                  |
 |                                                                         |
 | Respond to a Midi Player callback.  Typically when a sysex event is     |
 | sent, etc.                                                              |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 | Event  : PMidiEvent        // The callback event
 *-------------------------------------------------------------------------*)

procedure TMainForm.MidiPlayerCallback(Sender: TObject; Event: PMidiEvent);
begin
  MessageBeep ($ffff);
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.MidiPlayerStop                                      |
 |                                                                         |
 | Respond to the Midi Player saying it's stopped.                         |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.MidiPlayerStop(Sender: TObject);
begin
  MidiPlayer.AutoStop := True;
  if fRecording then
  begin
    with MidiInput do TrackOutputs.OpenTrack (Take [TakeCount - 1], Take [TakeCount - 1].TempPort);
    if Assigned (TakesForm) then
      TakesForm.Refresh
    else
      mnuViewTakesClick (self);
    fRecording := False
  end;

  BtnStop.Down := True;
  UpdateTimer.Enabled := False;
  DisplayCurrentPosition
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.MidiPlayerPlay                                      |
 |                                                                         |
 | Respond to the MidiPlayer saying it's started.                          |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.MidiPlayerPlay(Sender: TObject);
begin
  BtnPlay.Down := True;
  UpdateTimer.Enabled := True;
  if MidiInput.Recording then
    TimeDisplay.Color := clRed;
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.MidiPlayerFastForward                               |
 |                                                                         |
 | Respond to the midi player saying it's started to fast forward.         |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.MidiPlayerFastForward(Sender: TObject);
begin
  BtnFfwd.Down := True;
  UpdateTimer.Enabled := True;
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.MidiInputStepData                                   |
 |                                                                         |
 | Respond to MidiInput data when in step mode.                            |
 |                                                                         |
 | Parameters:                                                             |
 | const data : TEventData    // The step data received                    |
 *-------------------------------------------------------------------------*)

procedure TMainForm.MidiInputStepData(const data: TEventData);
var
   stepNoteLen : Integer;
   e : TEventData;
   dotted, quantize : boolean;
   endPos : Integer;
   startEvent, endEvent : PMidiEventData;
begin
  stepNoteLen := MidiData.PPQN;
  if Assigned (StepModeForm) then
    stepNoteLen := StepModeForm.AdjustNoteLen (stepNoteLen, dotted, quantize);
  if Assigned (MidiData.Tracks [CurrentTrackNo]) then
    case data.status and MidiStatusMask of
      midiNoteOn :
      begin
        MidiData.Tracks [CurrentTrackNo].BeginUpdate;
        try
          e.status := (data.status and MidiStatusMask) or MidiData.Tracks [CurrentTrackNo].Channel;
          e.b2 := data.b2;
          e.b3 := data.b3;
          startEvent := MidiData.Tracks [CurrentTrackNo].InsertEvent (MidiPlayer.Position, e, 0);

          e.status := (e.status and not MidiStatusMask) or midiNoteOff;
          e.b3 := 0;
          endPos := stepNoteLen;
          if dotted then endPos := endPos div 2;
          endPos := MidiPlayer.Position + endPos;

          endEvent := MidiData.Tracks [CurrentTrackNo].InsertEvent (endPos, e, 0);
          startEvent^.OnOffEvent := endEvent;
          endEvent^.OnOffEvent := startEvent;
        finally
          MidiData.Tracks [CurrentTrackNo].CancelUpdate
        end;
        Inc (stepNoteCount);
        NotifyAll;
      end;

      midiNoteOff :
        if stepNoteCount > 0 then
        begin
          Dec (stepNoteCount);
          if stepNoteCount = 0 then
          begin
            MidiPlayer.Position := MidiPlayer.Position + StepNoteLen;
            NotifyActiveForms (ntPositionUpdate);
            DisplayCurrentPosition
          end
        end
    end
end;

//==========================================================================
// Helper functions for Form properties

(*-------------------------------------------------------------------------*
 | procedure TMainForm.SetCurrentTrackNo                                   |
 |                                                                         |
 | Helper function for the 'CurrentTrackNo' property.  Update the display  |
 | etc. when the current track changes.                                    |
 |                                                                         |
 | Parameters:                                                             |
 | value : Integer       // The new track no.                              |
 *-------------------------------------------------------------------------*)

procedure TMainForm.SetCurrentTrackNo (value : Integer);
begin
  if value <> fCurrentTrackNo then
  begin
    fCurrentTrackNo := value;
    UpdateCurrentTrackDetails
  end
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.DisplayCurrentPosition                              |
 |                                                                         |
 | Helper function form the CurrentPosition property.  Update the          |
 | displayed position, and notify the active forms that the position has   |
 | changed.                                                                |
 |                                                                         |
 | Parameters:                                                             |
 | value : Integer       // The new position                               |
 *-------------------------------------------------------------------------*)

procedure TMainForm.DisplayCurrentPosition;
var bar, beat, tick, tempo, beatDiv : Integer;
begin
  MidiPlayer.GetBarPos (Bar, Beat, Tick);
  MidiPlayer.GetCurrentTempo (tempo, beatDiv);
  PosDisplay.SetPosition (bar, beat, tick);
  TimeDisplay.Time := MidiPlayer.Time;
  StatusBar.Panels [1].Text := Format ('Tempo %d', [GetBPM (tempo, beatDiv)]);
  NotifyActiveForms (ntPositionUpdate);
end;

//==========================================================================
// Private functions

(*-------------------------------------------------------------------------*
 | procedure TMainForm.NewSong                                             |
 |                                                                         |
 | Start a new song.  This is called at the very beginning, and also when  |
 | 'New Song' is selected.                                                 |
 *-------------------------------------------------------------------------*)

procedure TMainForm.NewSong;
begin
  MidiData.New;            // Re-initialise the midi data
  TrackOutputs.Active := True;
  MidiPlayer.Reset;

  if ShowInitialTracksheet then
    PostMessage (Handle, WM_COMMAND, ViewTrackSheet.Command, 0);

  SetCaption;              // Show the 'untitled' caption
  UpdateCurrentTrackDetails;
 // DisplayCurrentPosition;
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.OpenSong                                            |
 |                                                                         |
 | Open a song.  This is called a the beginning if there was anything on   |
 | the command line.  Also when the OpenSong dialog returns.               |
 |                                                                         |
 | Parameters:                                                             |
 | fileName : string         The song file to open.                        |
 *-------------------------------------------------------------------------*)
procedure TMainForm.OpenSong (fileName : string);
begin
  MidiData.FileName := fileName;
  MidiDir := ExtractFilePath (ExpandFileName (fileName));
                             // Save the path in the registry...
  with TReg.Create (HKEY_CURRENT_USER, ProgramKey + '\' + DirectoriesKey, True) do
  try
    WriteString (MidiFilePathValue, MidiDir);
  finally
    Free
  end;

  MidiData.Active := True;     // Load's the song

  TrackOutputs.Active := True;
  MidiPlayer.Reset;
  ResetPatchNames;

                               // Open an output port for each active track
  if ShowInitialTracksheet and (MidiData.FileType >= 1) then
    PostMessage (Handle, WM_COMMAND, ViewTrackSheet.Command, 0);

  if MidiData.FileType = 0 then
    CurrentTrackNo := 0;
    
  SetCaption;
  UpdateCurrentTrackDetails;
  DisplayCurrentPosition;
end;

(*-------------------------------------------------------------------------*
 | function TMainForm.CloseSong : boolean;                                 |
 |                                                                         |
 | Close a song.  This is called before a new song is opened, to close     |
 | the song.  If changes have been made, it prompts for saving.            |
 |                                                                         |
 | The function returns
 *-------------------------------------------------------------------------*)

function TMainForm.CloseSong : boolean;
begin
  result := False;
  if MidiData.Changes then
    case MessageDlg (Format ('Save changes to %s', [MidiData.ShortFileName]), mtInformation, mbYesNoCancel, 0) of
      mrYes    : result := SaveSong;
      mrNo     : result := True;
      mrCancel : result := False
    end
  else result := True;

  if Result then        // Ok to close ?
  begin
    MidiPlayer.Play := False;
    MidiPlayer.Position := 0;
    TrackOutputs.Active := False;
    MidiPlayer.Reset;
    MidiData.Active := False;
    WindowCloseAllClick (Nil);
    Application.ProcessMessages;
    CurrentTrackNo := 1
  end
end;

(*-------------------------------------------------------------------------*
 | function TMainForm.SaveSongAs : boolean;
 |                                                                         |
 |
 |

⌨️ 快捷键说明

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