fmtempomap.pas

来自「Delphi的另一款钢琴软件」· PAS 代码 · 共 95 行

PAS
95
字号
unit fmTempoMap;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  fmBar, cmpTimerSpeedButton, Buttons, ExtCtrls, fmPower, 
  cmpTempoMap, cmpBarControl;

type
  TTempoMapForm = class(TBarForm)
    Bevel1: TBevel;
    TempoMap1: TTempoMap;
    pnlLeftMargin: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    UStretcher: TTimerSpeedButton;
    DStretcher: TTimerSpeedButton;
    procedure FormShow(Sender: TObject);
    procedure RStretcherClick(Sender: TObject);
    procedure LStretcherClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure UStretcherClick(Sender: TObject);
    procedure DStretcherClick(Sender: TObject);
  private
    procedure AdjustHeader;
  public
    procedure Notify (tp : TactiveFormNotify); override;
  end;

var
  TempoMapForm: TTempoMapForm;

implementation

uses fmMainForm;

{$R *.DFM}

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

procedure TTempoMapForm.FormShow(Sender: TObject);
begin
  inherited;
  SetCaption ('Tempo Map', 0);
  AdjustHeader
end;

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

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

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

procedure TTempoMapForm.AdjustHeader;
begin
  pnlLeftMargin.Height := TempoMap1.ActiveHeight + 1;
  DStretcher.Top := pnlLeftMargin.Height - DStretcher.Height - 1;
end;

procedure TTempoMapForm.UStretcherClick(Sender: TObject);
begin
  inherited;
  TempoMap1.MaxTempo := TempoMap1.MaxTempo - 10;
end;

procedure TTempoMapForm.DStretcherClick(Sender: TObject);
begin
  inherited;
  TempoMap1.MaxTempo := TempoMap1.MaxTempo + 10;
end;

end.

⌨️ 快捷键说明

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