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

📄 fmtracksheet.pas

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

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fmPower, Grids, ComCtrls, Menus, ExtCtrls;

type
  TTracksheetForm = class(TForm)
    dgTracks: TDrawGrid;
    PopupMenu1: TPopupMenu;
    poEventList: TMenuItem;
    poNoteEditor: TMenuItem;
    poTempoMap: TMenuItem;
    N1: TMenuItem;
    poProperties: TMenuItem;
    StepModeRecord1: TMenuItem;
    HeaderControl1: THeaderControl;
    ControllerMap1: TMenuItem;
    Mute1: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormResize(Sender: TObject);
    procedure HeaderControl1SectionResize(HeaderControl: THeaderControl;
      Section: THeaderSection);
    procedure dgTracksDrawCell(Sender: TObject; Col, Row: Longint;
      Rect: TRect; State: TGridDrawState);
    procedure poPropertiesClick(Sender: TObject);
    procedure dgTracksDblClick(Sender: TObject);
    procedure dgTracksClick(Sender: TObject);
    procedure poEventListClick(Sender: TObject);
    procedure StepModeRecord1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure poNoteEditorClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure poTempoMapClick(Sender: TObject);
    procedure ControllerMap1Click(Sender: TObject);
    procedure Mute1Click(Sender: TObject);
  private
    procedure AdjustHeader;
    procedure AdjustGrid;
    procedure SetPopupMenuOptions;
  public
    procedure SelectTrack (trackNo : Integer);
    procedure Notify;
    procedure CutToClipboard;
    procedure DeleteToClipboard;
    procedure CopyToClipboard;
    procedure PasteFromClipboard;
    { Public declarations }
  end;

var
  TracksheetForm: TTracksheetForm;

implementation

uses fmMainForm, commctrl;

{$R *.DFM}

const
  Sections = 8;
  SectionLoadings : array [0..Sections - 1] of Integer = (1, 4, 4, 2, 2, 2, 2, 1);
  MaxLoadings = 18;

procedure TTracksheetForm.AdjustHeader;
var i, width : Integer;
begin
  width := dgTracks.ClientWidth;
  for i := 0 to Sections - 2 do
    HeaderControl1.Sections [i].Width := width * SectionLoadings [i] div MaxLoadings;

  AdjustGrid;
end;

procedure TTracksheetForm.AdjustGrid;
var i, totWidth : Integer;
begin
  totWidth := 0;
  for i := 0 to Sections - 2 do
    Inc (totWidth, HeaderControl1.Sections [i].width);

  HeaderControl1.Sections [Sections - 1].width := dgTracks.ClientWidth - totWidth;
  for i := 0 to Sections - 1 do
    dgTracks.ColWidths [i] := HeaderControl1.Sections [i].Width - 1
end;

procedure TTracksheetForm.FormDestroy(Sender: TObject);
begin
  TracksheetForm := Nil;
end;

procedure TTracksheetForm.FormShow(Sender: TObject);
begin
  with HeaderControl1 do
    SetWindowLong (Handle, GWL_STYLE, GetWindowLong (HeaderControl1.Handle, GWL_STYLE) and not HDS_BUTTONS);
  MainForm.ViewTracksheet.Checked := True;
  AdjustHeader;
  SetPopupMenuOptions
end;

procedure TTracksheetForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
  MainForm.ViewTracksheet.Checked := False;
end;

procedure TTracksheetForm.FormResize(Sender: TObject);
begin
  AdjustHeader
end;

procedure TTracksheetForm.HeaderControl1SectionResize(
  HeaderControl: THeaderControl; Section: THeaderSection);
var
  i, idx, widthLeft, sectionsLeft : Integer;
begin
  for idx := 0 to Sections - 1 do
    if Section = HeaderControl.Sections [idx] then
      break;

  widthLeft := dgTracks.ClientWidth;
  for i := 0 to idx do
    Dec (widthLeft, HeaderControl1.Sections [i].Width);

  sectionsLeft := 0;
  for i := idx + 1 to Sections - 1 do
    Inc (sectionsLeft, sectionLoadings [i]);

  for i := idx + 1 to Sections - 2 do
    HeaderControl1.Sections [i].Width := widthLeft * SectionLoadings [i] div sectionsLeft;

  AdjustGrid;
end;

procedure TTracksheetForm.dgTracksDrawCell(Sender: TObject; Col,
  Row: Longint; Rect: TRect; State: TGridDrawState);
var
  st : string;
begin
  if Col = 0 then
    st := IntToStr (row + 1)
  else
    if Assigned (MainForm.MidiData.Tracks [row + 1]) then
      with MainForm.MidiData.Tracks [row + 1] do
        case Col of
          1 : st := TrackName;
          2 : st := InstrumentName;
          3 : st := IntToStr (Channel + 1);
          4 : st := IntToStr (Bank);
          5 : st := IntToStr (Patch);
          6 : st := IntToStr (EventCount);
          7 : if MainForm.TrackOutputs.TrackOutput [row + 1].Mute then
                st := 'Mute'
              else
                st := '-'
        end;
  Dec (Rect.Right, 1);
  dgTracks.Canvas.TextRect (Rect, Rect.Left + 2, Rect.Top + 2, st);
end;

procedure TTracksheetForm.poPropertiesClick(Sender: TObject);
begin
  MainForm.GetTrackProperties
end;

procedure TTracksheetForm.dgTracksDblClick(Sender: TObject);
begin
  MainForm.GetTrackProperties
end;

procedure TTracksheetForm.dgTracksClick(Sender: TObject);
begin
  MainForm.CurrentTrackNo := dgTracks.Row + 1;
  SetPopupMenuOptions
end;

procedure TTracksheetForm.poEventListClick(Sender: TObject);
begin
  MainForm.ViewEventListClick (Nil);
end;

procedure TTracksheetForm.SelectTrack (trackNo : Integer);
begin
  dgTracks.Row := trackNo - 1;
  SetPopupMenuOptions
end;

procedure TTracksheetForm.SetPopupMenuOptions;
var Enable : boolean;
begin
  Enable := Assigned (MainForm.MidiData.Tracks [dgTracks.Row + 1]);
  poEventList.Enabled := Enable;
  poNoteEditor.Enabled := Enable;
  poTempoMap.Enabled := Enable
end;

procedure TTracksheetForm.Notify;
begin
  dgTracks.Refresh
end;


procedure TTracksheetForm.StepModeRecord1Click(Sender: TObject);
begin
  MainForm.TrackStepModeRecordClick (Sender)
end;

procedure TTracksheetForm.PopupMenu1Popup(Sender: TObject);
begin
  with MainForm do
  begin
    StepModeRecord1.Checked := TrackStepModeRecord.Checked;
    if CurrentTrackNo < TrackOutputs.NoTracks then
      Mute1.Checked := TrackOutputs [CurrentTrackNo].Mute
  end
end;

procedure TTracksheetForm.poNoteEditorClick(Sender: TObject);
begin
  MainForm.ViewNoteEditorClick (Nil);
end;

procedure TTracksheetForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  MainForm.FormKeyDown (Sender, Key, Shift);
end;

procedure TTracksheetForm.DeleteToClipboard;
begin
  with MainForm, MidiData.Tracks [CurrentTrackNo] do
  begin
    DeleteToClipboard (selStartPos, selEndPos);
    NotifyAll
  end
end;

procedure TTracksheetForm.CopyToClipboard;
begin
  with MainForm, MidiData.Tracks [CurrentTrackNo] do
    CopyToClipboard (selStartPos, selEndPos);
end;

procedure TTracksheetForm.PasteFromClipboard;
begin
  with MainForm, MidiData.Tracks [CurrentTrackNo] do
  begin
    PasteFromClipboard (CurrentPosition);
    NotifyAll
  end
end;

procedure TTracksheetForm.CutToClipboard;
begin
  with MainForm, MidiData.Tracks [CurrentTrackNo] do
  begin
    CutToClipboard (selStartPos, selEndPos);
    NotifyAll
  end
end;

procedure TTracksheetForm.poTempoMapClick(Sender: TObject);
begin
  MainForm.ViewTempoMapClick (Nil);
end;

procedure TTracksheetForm.ControllerMap1Click(Sender: TObject);
begin
  MainForm.ViewControllerMapClick (Nil);
end;

procedure TTracksheetForm.Mute1Click(Sender: TObject);
begin
  with MainForm do
    if CurrentTrackNo < TrackOutputs.NoTracks then
    begin
      with TrackOutputs.TrackOutput [CurrentTrackNo] do
        Mute := not Mute;

      dgTracks.Refresh
    end

end;

end.

⌨️ 快捷键说明

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