fmmainform.pas

Delphi的另一款钢琴软件

 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.SongPropertiesClick(Sender: TObject);
var
  dialog : TSongPropertiesForm;
  iterator : TMidiPosition;
  c, i : Integer;
  lowerDiv : Integer;
  s : string;
  key : ShortInt;
begin
  dialog := TSongPropertiesForm.Create (self);
  iterator := TMidiIterator.Create (self);
  iterator.MidiData := MidiData;
  try
    dialog.edResolution.Text := IntToStr (MidiData.ppqn);
    dialog.edFormat.Text := Format ('Type %d', [MidiData.FileType]);
    dialog.edNumberOfTracks.Text := IntToStr (MidiData.NoTracks);

    with MidiData do
      if Assigned (Tracks [0]) then with Tracks [0] do
      begin
        c := EventCount;
        for i := 0 to c - 1 do
          with Event [i]^ do
          begin
            iterator.position := pos;
          	if data.Status = midiMeta then with data do
              case byte (sysex [0]) of
                metaTimesig :
                  with dialog.lvTimeSignatures.Items.Add do
                  begin
                    if Integer (sysex [2]) < 2 then
                      lowerDiv := 4 shr (2 - Integer (sysex [2]))
                    else
                      lowerDiv := 4 shl (Integer (sysex [2]) - 2);
                    with Iterator do Caption := Format ('%d-%02.2d-%03.3d', [bar + 1, beat + 1, tick]);
                    SubItems.Add (Format ('%d/%d', [Integer (sysex [1]), LowerDiv]));
                  end;

                metaKeySig :
                  with dialog.lvKeySignatures.Items.Add do
                  begin
                    ImageIndex := 1;
                    with Iterator do Caption := Format ('%d-%02.2d-%03.3d', [bar + 1, beat + 1, tick]);
                    key := ShortInt (sysex [1]);
                    if key < 0 then
                      s := Char (Ord ('A') + (7 + (key + 1)) mod 7) + ' Min'
                    else
                      s := Char (Ord ('A') + key ) + ' Maj';
                    SubItems.Add (s);
                  end;
              end
          end
      end;

    if dialog.ShowModal = mrOk then
    begin
      MidiData.ppqn := StrToInt (dialog.edResolution.Text);
      NotifyActiveForms (ntFullUpdate)
    end
  finally
    iterator.Free;
    dialog.Free
  end

end;

//==========================================================================
// Window menu event handlers

(*-------------------------------------------------------------------------*
 | procedure TMainForm.WindowCascadeClick                                  |
 |                                                                         |
 | Respond to a Window/Cascade event                                       |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.WindowCascadeClick(Sender: TObject);
begin
  Cascade
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.WindowTileHorizontalClick                           |
 |                                                                         |
 | Respond to a Window/TileHorizontal event                                |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.WindowTileHorizontalClick(Sender: TObject);
begin
  TileMode := tbHorizontal;
  Tile
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.WindowTileVerticalClick                             |
 |                                                                         |
 | Respond to a Window/TileVertical event                                  |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.WindowTileVerticalClick(Sender: TObject);
begin
  TileMode := tbVertical;
  Tile
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.WindowCloseAllClick                                 |
 |                                                                         |
 | Respond to a Window/CloseAll event                                      |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.WindowCloseAllClick(Sender: TObject);
var i : Integer;
begin
  for i := 0 to ComponentCount - 1 do
    if Components [i] is TForm then
      TForm (Components [i]).Close;
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.WindowMinimizeAllClick                              |
 |                                                                         |
 | Respond to a Window/MinimizeAll event                                   |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.WindowMinimizeAllClick(Sender: TObject);
var i : Integer;
begin
  for i := 0 to ComponentCount - 1 do
    if Components [i] is TForm then
      TForm (Components [i]).WindowState := wsMinimized
end;

//==========================================================================
// Help menu event handlers

(*-------------------------------------------------------------------------*
 | procedure TMainForm.HelpAboutClick                                      |
 |                                                                         |
 | Respond to a Help/About event                                           |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.HelpAboutClick(Sender: TObject);
begin
  with TfmStdAboutBox.Create (self) do
  try
    ShowModal;
  finally
    Free
  end
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.HelpContentsClick                                   |
 |                                                                         |
 | Respond to a Help/ContentsClick event                                   |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.HelpContentsClick(Sender: TObject);
begin
  Application.HelpJump ('Introduction');
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.HelpHowtoUseHelpClick                               |
 |                                                                         |
 | Respond to a Help/HowToUseHelp event                                    |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.HelpHowtoUseHelpClick(Sender: TObject);
begin
  Application.HelpCommand (HELP_HELPONHELP, 0);
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.HelpSearchforHelpOnClick                            |
 |                                                                         |
 | Respond to a Help/SearchForHelpOn event                                 |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.HelpSearchforHelpOnClick(Sender: TObject);
begin
  Application.HelpCommand (HELP_FINDER, 0);
end;

//==========================================================================
// Transport panel event handlers

(*-------------------------------------------------------------------------*
 | procedure TMainForm.btnRewindClick                                      |
 |                                                                         |
 | Respond to a Rewind click                                               |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.btnRewindClick(Sender: TObject);
begin
  MidiInput.SetRecording (False, Nil);
  MidiPlayer.Rewind;
  DisplayCurrentPosition;
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.btnStopClick                                        |
 |                                                                         |
 | Respond to a Stop click                                                 |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.btnStopClick(Sender: TObject);
begin
  if MidiInput.Recording then
    MidiInput.SetRecording (False, Nil);
  MidiPlayer.Stop;
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.btnPlayClick                                        |
 |                                                                         |
 | Respond to a 'Play' button click.                                       |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.btnPlayClick(Sender: TObject);
begin
  try
    MidiInput.SetRecording (False, Nil);
    MidiPlayer.Play := True;
  except
    btnStop.Down := True
  end
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.btnFfwdClick                                        |
 |                                                                         |
 | Respond to a 'Fast Forward' button click                                |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.btnFfwdClick(Sender: TObject);
begin
  try
    MidiInput.SetRecording (False, Nil);
    MidiPlayer.FastForward := True;
  except
    btnStop.Down := True
  end
end;

(*-------------------------------------------------------------------------*
 | procedure TMainForm.btnRecordClick                                      |
 |                                                                         |
 | Respond to the 'record' button.                                         |
 |                                                                         |
 | Parameters:                                                             |
 | Sender : TObject           // The event sender                          |
 *-------------------------------------------------------------------------*)

procedure TMainForm.btnRecordClick(Sender: TObject);
begin
  try
    MidiPlayer.AutoStop := False;
    MidiInput.RecordStartTime := MidiPlayer.Time;
    MidiPlayer.Play := True;
    MidiInput.SetRecording (True, MidiData);
    fRecording := True;
  except