{ ****************************************************************** }
{ }
{ VCL component TDTNTMMPlayer }
{ }
{ This was developed by request!! }
{ }
{ }
{ Copyright ® 2001 by Jason White jason@dtnt.co.uk }
{ }
{ ****************************************************************** }


unit DTNTMMPlayer;

interface

uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,
 Forms, Graphics, Mplayer, mmsystem;

type
 TDTNTMMPlayer = class(TMediaPlayer)
 private
 { Private fields of TDTNTMMPlayer }
 { Pointer to application's OnChangeTempoError handler, if any }
 FOnChangeTempoError : TNotifyEvent;
 { Pointer to application's OnTempoChanged handler, if any }
 FOnTempoChanged : TNotifyEvent;

 { Private methods of TDTNTMMPlayer }
 { Method to set variable and property values and create objects }
 procedure AutoInitialize;
 { Method to free any objects created by AutoInitialize }
 procedure AutoDestroy;

 protected
 { Protected fields of TDTNTMMPlayer }

 { Protected methods of TDTNTMMPlayer }
 { Method to generate OnChangeTempoError event }
 procedure ChangeTempoError(Sender : TObject); virtual;
 { Method to generate OnTempoChanged event }
 procedure TempoChanged(Sender : TObject); virtual;
 procedure Loaded; override;
 procedure Paint; override;

 public
 { Public fields and properties of TDTNTMMPlayer }

 { Public methods of TDTNTMMPlayer }
 constructor Create(AOwner: TComponent); override;
 destructor Destroy; override;
 { SetsTempo }
 procedure SetTempo( Value : Integer );

 published
 { Published properties of TDTNTMMPlayer }
 property OnChangeTempoError : TNotifyEvent read FOnChangeTempoError
 write FOnChangeTempoError;
 { Tempo Changed Event }
 property OnTempoChanged : TNotifyEvent read FOnTempoChanged
 write FOnTempoChanged;
 property OnClick;
 property OnEnter;
 property OnExit;
 property OnNotify;
 property OnPostClick;
 property AutoEnable default True;
 property AutoOpen default False;
 property AutoRewind default True;
 property ColoredButtons
 default [btPlay, btPause, btStop, btNext, btPrev, btStep,
 btBack, btRecord, btEject];
 property DeviceType default dtAutoSelect;
 property EnabledButtons
 default [btPlay, btPause, btStop, btNext, btPrev, btStep,
 btBack, btRecord, btEject];
 property FileName;
 property Shareable default False;
 property Visible default True;
 property VisibleButtons
 default [btPlay, btPause, btStop, btNext, btPrev, btStep,
 btBack, btRecord, btEject];

 end;

procedure Register;

implementation

procedure Register;
begin
 { Register TDTNTMMPlayer with D-TNT as its
 default page on the Delphi component palette }
 RegisterComponents('D-TNT', [TDTNTMMPlayer]);
end;

{ Method to set variable and property values and create objects }
procedure TDTNTMMPlayer.AutoInitialize;
begin
 AutoEnable := True;
 AutoOpen := False;
 AutoRewind := True;
 ColoredButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
 btBack, btRecord, btEject];
 DeviceType := dtAutoSelect;
 EnabledButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
 btBack, btRecord, btEject];
 Shareable := False;
 Visible := True;
 VisibleButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
 btBack, btRecord, btEject];
end; { of AutoInitialize }

{ Method to free any objects created by AutoInitialize }
procedure TDTNTMMPlayer.AutoDestroy;
begin
 { No objects from AutoInitialize to free }
end; { of AutoDestroy }

{ Method to generate OnChangeTempoError event }
procedure TDTNTMMPlayer.ChangeTempoError(Sender : TObject);
begin
 { Has the application assigned a method to the event, whether
 via the Object Inspector or a run-time assignment? If so,
 execute that method }
 if Assigned(FOnChangeTempoError) then
 FOnChangeTempoError(Sender);
end;

{ Method to generate OnTempoChanged event }
procedure TDTNTMMPlayer.TempoChanged(Sender : TObject);
begin
 { Has the application assigned a method to the event, whether
 via the Object Inspector or a run-time assignment? If so,
 execute that method }
 if Assigned(FOnTempoChanged) then
 FOnTempoChanged(Sender);
end;

constructor TDTNTMMPlayer.Create(AOwner: TComponent);
begin
 { Call the Create method of the parent class }
 inherited Create(AOwner);

 { AutoInitialize sets the initial values of variables and }
 { properties; also, it creates objects for properties of }
 { standard Delphi object types (e.g., TFont, TTimer, }
 { TPicture) and for any variables marked as objects. }
 { AutoInitialize method is generated by Component Create. }
 AutoInitialize;

 { Code to perform other tasks when the component is created }

end;

destructor TDTNTMMPlayer.Destroy;
begin
 { AutoDestroy, which is generated by Component Create, frees any }
 { objects created by AutoInitialize. }
 AutoDestroy;

 { Here, free any other dynamic objects that the component methods }
 { created but have not yet freed. Also perform any other clean-up }
 { operations needed before the component is destroyed. }

 { Last, free the component by calling the Destroy method of the }
 { parent class. }
 inherited Destroy;
end;

procedure TDTNTMMPlayer.Loaded;
begin
 inherited Loaded;

 { Perform any component setup that depends on the property
 values having been set }

end;

procedure TDTNTMMPlayer.Paint;
begin
 { Make this component look like its parent component by calling
 its parent's Paint method. }
 inherited Paint;

 { To change the appearance of the component, use the methods
 supplied by the component's Canvas property (which is of
 type TCanvas). For example, }

 { Canvas.Rectangle(0, 0, Width, Height); }
end;

{ SetsTempo }
procedure TDTNTMMPlayer.SetTempo( Value : Integer );
var
 Flags: LongInt;
 SeqParm: TMCI_Seq_Set_Parms;
begin
pause;

 if DeviceType = dtSequencer then
 begin
 SeqParm.dwTempo := Value;
 Flags := MCI_SEQ_SET_TEMPO;
 mciSendCommand(DeviceID, MCI_SET, Flags, Longint(@SeqParm));
 TempoChanged(self);
 end
 else
 ChangeTempoError(self);

resume;
end;

end.