fmcontroller.pas

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

unit fmController;

interface

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

type
  TControllerForm = class(TBarForm)
    Bevel1: TBevel;
    pnlLeftMargin: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    ControllerMap1: TControllerMap;
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure LStretcherClick(Sender: TObject);
    procedure RStretcherClick(Sender: TObject);
  private
    procedure AdjustHeader;
  public
    procedure Notify (tp : TActiveFormNotify); override;
  end;

var
  ControllerForm: TControllerForm;

implementation

uses unitmidiGlobals, fmMainForm;

{$R *.DFM}

procedure TControllerForm.AdjustHeader;
begin
  pnlLeftMargin.Height := ControllerMap1.ActiveHeight + 1;
end;

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

procedure TControllerForm.FormShow(Sender: TObject);
var
  controllerName : string;
begin
  ControllerMap1.Track := MainForm.CurrentTrackNo;
  inherited;
  controllerName := ControllerNames [ControllerMap1.Controller];
  if controllerName = '' then
    controllerName := Format ('Controller %d', [ControllerMap1.Controller]);
  SetCaption (controllerName, ControllerMap1.Track);
  AdjustHeader
end;

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

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

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

end.