Пример компонента типа TMediaPlayer с регулированием темпа звучания
{ ****************************************************************** }{ }{ VCL component TDTNTMMPlayer }{ }{ This was developed by request!! }{ }{ }{ Copyright ® 2001 by Jason White jason@dtnt.co.uk }{ }{ ****************************************************************** }unit DTNTMMPlayer;
interfaceuses 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;
procedureRegister;
implementationprocedureRegister;
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;
begininherited 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 thenbegin
SeqParm.dwTempo := Value;
Flags := MCI_SEQ_SET_TEMPO;
mciSendCommand(DeviceID, MCI_SET, Flags, Longint(@SeqParm));
TempoChanged(self);
endelse
ChangeTempoError(self);
resume;
end;
end.