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

Советы » Аудио » Пример компонента типа 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

.

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

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com