{ ****************************************************************** }
{ }
{ 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.
|