Пример компонента типа TMediaPlayer с регулированием темпа звучания

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