Пример компонента типа 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
.

Другое по теме:

• Как воспроизвести wav-файл из ресурса (в EXE)
• Работа с микрофоном
• Изменение громкости