cmpmidiplayer.pas

Delphi的另一款钢琴软件

unit cmpMidiPlayer;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, cmpMidiOutput, cmpTrackOutputs, mmsystem, cmpMidiData, cmpMidiIterator, cmpMidiInput, unitMidiGlobals;

type
PTrackEvents = ^PMidiEventData;

TMidiPlayerState = (stStopped, stStopping, stPaused, stPlaying, stFastForward);

TMidiPlayer = class(TComponent)
private
  fTrackOutputs : TTrackOutputs;
  fMidiInput : TMidiInput;
  fMult : Integer;
  fIterator : TMidiIterator;
  fTimerPeriod : Integer;
  fTimerResolution : Integer;
  fState : TMidiPlayerState;
  fTickCount : Integer;
  fTempoPercent : Integer;

  fOnStop : TNotifyEvent;
  fOnPause : TNotifyEvent;
  fOnPlay : TNotifyEvent;
  fOnFastForward : TNotifyEvent;
  fBoostPriority : boolean;
  fAutoStop : boolean;

  stopPosition : Integer;
  normalPriority : Integer;

  timerID : Integer;
  MinTimerPeriod : Integer;

  procedure SetPlay (value : boolean);
  function GetPlay : boolean;

  procedure SetFastForward (value : boolean);
  function GetFastForward : boolean;

  procedure SetPaused (value : boolean);
  function GetPaused : boolean;

  function GetTime : Integer;
  function GetPosition : Integer;
  procedure SetPosition (value : Integer);

  procedure SetTimerPeriod (value : Integer);
  procedure SetTimerResolution (value : Integer);
  procedure SetTrackOutputs (value : TTrackOutputs);

  function GetEndOfSong : boolean;

  procedure PlayIt (mult : Integer);
protected
  procedure SetState (value : TMidiPlayerState);
  { Protected declarations }
public
  constructor Create (AOwner : TComponent); override;
  destructor Destroy; override;
  procedure Stop;
  procedure Rewind;
  procedure AllNotesOff;
  procedure ResetAllControllers;
  procedure GetBarPos (var bar, beat, tick : Integer);
  procedure GetCurrentTempo (var tempo, beatDiv : Integer);
  procedure SetBarPos (bar, beat, tick : Integer);
  procedure SetEndPosition;
  procedure Reset;
  property EndOfSong : boolean read GetEndOfSong;
  property AutoStop : boolean read fAutoStop write fAutoStop;

published
  property Play : boolean read GetPlay write SetPlay;
  property FastForward : boolean read GetFastForward write SetFastForward;
  property Paused : boolean read GetPaused write SetPaused;
  property Position : Integer read GetPosition write SetPosition;
  property Time : Integer read GetTime;
  property TimerPeriod : Integer read fTimerPeriod write SetTimerPeriod noDefault;
  property TimerResolution : Integer read fTimerResolution write SetTimerResolution;
  property TrackOutputs : TTrackOutputs read fTrackOutputs write SetTrackOutputs;
  property BoostPriority : boolean read fBoostPriority write fBoostPriority;
  property MidiInput : TMidiInput read fMidiInput write fMidiInput;
  property TempoPercent : Integer read fTempoPercent write fTempoPercent default 100;

  property OnStop : TNotifyEvent read fOnStop write fOnStop;
  property OnPlay : TNotifyEvent read fOnPlay write fOnPlay;
  property OnFastForward : TNotifyEvent read fOnFastForward write fOnFastForward;
  property OnPause : TNotifyEvent read fOnPause write fOnPause;
end;

implementation

const
  PROCESS_SET_INFORMATION = $200;

constructor TMidiPlayer.Create (AOwner : TComponent);
var
  caps : TTimeCaps;
  processHandle : THandle;
begin
  inherited Create (AOwner);
  timeGetDevCaps (@caps, sizeof (caps));
  MinTimerPeriod := caps.wPeriodMin;
  fTimerPeriod := MinTimerPeriod;
  fTimerResolution := 4;
  fTempoPercent := 100;
  fIterator := TMidiIterator.Create (self);
  fAutoStop := True;
  processHandle := OpenProcess (PROCESS_SET_INFORMATION, False, GetCurrentProcessID);
  normalPriority := GetPriorityClass (processHandle);
  CloseHandle (processHandle);
end;

destructor TMidiPlayer.Destroy;
begin
  Stop;
  inherited Destroy;
end;

procedure TMidiPlayer.SetPlay (value : boolean);
begin
  case fState of
    stStopped : if value then PlayIt (1);
    stPlaying : if not value then Stop;

    stPaused,
    stFastForward :
      begin
        fMult := 1;
        SetState (stPlaying)
      end;

  end
end;

function TMidiPlayer.GetPlay : boolean;
begin
  result := fState = stPlaying
end;

procedure TMidiPlayer.SetFastForward (value : boolean);
begin
  case fState of
    stStopped     : if value then PlayIt (4);
    stFastForward : if not value then Stop;
    stPaused,
    stPlaying :
      begin
        fMult := 4;
        SetState (stFastForward)
      end
  end
end;

function TMidiPlayer.GetFastForward : boolean;
begin
  result := fState = stFastForward;
end;

procedure TMidiPlayer.SetPaused (value : boolean);
begin
  if fState >= stPlaying then SetState (stPaused) else SetState (stStopped);
end;

function TMidiPlayer.GetPaused : boolean;
begin
  result := fState = stPaused
end;

procedure TMidiPlayer.AllNotesOff;
begin
  if Assigned (fTrackOutputs) then
    fTrackOutputs.AllNotesOff;
end;

procedure TMidiPlayer.ResetAllControllers;
begin
  if Assigned (fTrackOutputs) then
    fTrackOutputs.ResetAllControllers;
end;

function TMidiPlayer.GetPosition  : Integer;
begin
  result := fIterator.Position;
end;

procedure TMidiPlayer.SetPosition (value : Integer);
var
  oldState : TMidiPlayerState;
begin
  oldState := fState;
  if fState > stPaused then fState := stPaused;
  AllNotesOff;
  if value < Position then
    ResetAllControllers;
  fIterator.SetPosition (value);
  if fState = stPaused then fState := oldState;
end;

function TMidiPlayer.GetTime : Integer;
begin
  result := fIterator.Time;
end;

procedure TMidiPlayer.SetTimerPeriod (value : Integer);
begin
  if value <> fTimerPeriod then
  begin
    if value < MinTimerPeriod then value := MinTimerPeriod;
    fTimerPeriod := value
  end
end;

procedure TMidiPlayer.SetTimerResolution (value : Integer);
begin
  if value <> fTimerResolution then
  begin
    fTimerResolution := value
  end
end;

var
  inTimerProc : DWORD = 0;

procedure timerProc (id, msg : UINT; player : DWORD; dw1, dw2 : DWORD); stdcall;
var
  newTickCount : Integer;
  deltaTime : Integer;
begin
  if inTimerProc = 0 then
  begin
    Inc (inTimerProc);
    with TMidiPlayer (player) do if fState <> stPaused then
    begin
      newTickCount := timeGetTime;
      deltaTime := newTickCount - fTickCount;
      fTickCount := newTickCount;
      fIterator.IterateByTime (deltaTime * fTempoPercent div 100 * fMult);
      if fIterator.EndOfSong and fAutoStop then
        stop
    end;
    Dec (inTimerProc)
  end
end;

procedure TMidiPlayer.GetBarPos (var bar, beat, tick : Integer);
begin
  bar := fIterator.Bar;
  beat := fIterator.Beat;
  tick := fIterator.Tick
end;

procedure TMidiPlayer.SetBarPos (bar, beat, tick : Integer);
var
  oldState : TMidiPlayerState;
begin
  fIterator.MidiData := fTrackOutputs.MidiData;
  oldState := fState;
  if fState > stPaused then fState := stPaused;
  AllNotesOff;
  fIterator.SetBarPosition (bar, beat, tick);
  if fState = stPaused then fState := oldState;
end;

procedure TMidiPlayer.SetEndPosition;
var
  oldState : TMidiPlayerState;
begin
  fIterator.MidiData := fTrackOutputs.MidiData;
  oldState := fState;
  if fState > stPaused then fState := stPaused;
  AllNotesOff;
  fIterator.SetLastNotePosition;
  if fState = stPaused then fState := oldState;
end;

procedure TMidiPlayer.PlayIt (mult : Integer);
var
  pos : Integer;
  processHandle : THandle;
begin
  if not Assigned (fTrackOutputs) or not fTrackOutputs.Active then
  begin
    fState := stPlaying;
    SetState (stStopped);
    Exit
  end;

  fIterator.MidiData := fTrackOutputs.MidiData;

  pos := fIterator.Position;
  fIterator.Position := stopPosition;
  fState := stPaused;
  fIterator.position := pos;

  fMult := mult;
  if timeBeginPeriod (TimerPeriod) = TIMERR_NOERROR then
  begin
    if fBoostPriority then
    begin
      processHandle := OpenProcess (PROCESS_SET_INFORMATION, False, GetCurrentProcessID);
      normalPriority := GetPriorityClass (processHandle);
      SetPriorityClass (processHandle, REALTIME_PRIORITY_CLASS);
      CloseHandle (processHandle)
    end;
    fTickCount := timeGetTime;
    timerID := timeSetEvent (fTimerResolution, 0, timerProc, DWORD (self), TIME_PERIODIC);
    if timerID <> 0 then
      if mult = 1 then
        SetState (stPlaying) else SetState (stFastForward)
    else SetState (stStopped);
  end
  else SetState (stStopped);
end;

procedure TMidiPlayer.Stop;
var
  ProcessHandle : THandle;
begin
  if fState >= stPaused then
  begin
    timeKillEvent (timerID);
    timeEndPeriod (TimerPeriod);
    AllNotesOff;
    processHandle := OpenProcess (PROCESS_SET_INFORMATION, False, GetCurrentProcessID);
    SetPriorityClass (processHandle, normalPriority);
    CloseHandle (processHandle);
    stopPosition := Position;
  end;

  SetState (stStopped)
end;

procedure TMidiPlayer.Rewind;
begin
  Stop;
  fIterator.SetBarPosition (0, 0, 0);
end;

procedure TMidiPlayer.SetState (value : TMidiPlayerState);
begin
  if value <> fState then
  begin
    fState := value;
    if not (csDestroying in ComponentState) then
    case value of
      stStopped : if Assigned (fOnStop) then fOnStop (self);
      stPaused  : if Assigned (fOnPause) then fOnPause (self);
      stPlaying : if Assigned (fOnPlay) then fOnPlay (self);
      stFastForward  : if Assigned (fOnFastForward) then fOnFastForward (self)
    end
  end
end;

procedure TMidiPlayer.SetTrackOutputs (value : TTrackOutputs);
begin
  if fTrackOutputs <> value then
  begin
    Rewind;
    fTrackOutputs := value;
    fIterator.TrackOutputs := value;
    Reset
  end
end;

procedure TMidiPlayer.Reset;
begin
  Stop;
  if Assigned (fTrackOutputs) and fTrackOutputs.Active then
    fIterator.MidiData := fTrackOutputs.MidiData
  else
    fIterator.MidiData := Nil;
end;

procedure TMidiPlayer.GetCurrentTempo (var tempo, beatDiv : Integer);
begin
  tempo := fIterator.Tempo;
  beatDiv := fIterator.BeatDiv
end;

function TMidiPlayer.GetEndOfSong : boolean;
begin
  result := fIterator.EndOfSong
end;

end.