www.pudn.com > d4psp31.zip > cmpMidiPlayer.pas, change:1998-11-01,size:10311b


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; 
 
procedure timerProc (id, msg : UINT; player : DWORD; dw1, dw2 : DWORD); stdcall; 
var 
  newTickCount : Integer; 
  deltaTime : Integer; 
const 
  inTimerProc : DWORD = 0; 
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 <> NULL 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.