unit uMciPlayer;
interface
uses
Classes;
type
TMciPlayerState = ( mpsClosed, mpsStopped, mpsPlaying, mpsPaused );
TMciPlayer =
class
private
FAlias :
string;
FState : TMciPlayerState;
FDuration : Integer;
FFileName :
string;
function GetPosition : Integer;
procedure SetFileName(
const Value :
string );
function GetState : TMciPlayerState;
procedure SetState(
const Value : TMciPlayerState );
protected
procedure DoCallCommand(
const CmdStr :
string );
overload;
procedure DoCallCommand(
const CmdStr :
string;
out ResultStr :
string );
overload;
procedure DoOpen;
procedure DoClose;
public
constructor Create;
destructor Destroy;
override;
procedure Open(
const aFileName :
string; aAutoPlay : Boolean = False );
procedure Play;
procedure Stop;
procedure Pause;
procedure Resume;
property State : TMciPlayerState
read GetState;
property Duration : Integer
read FDuration;
property Position : Integer
read GetPosition;
property Alias :
string read FAlias;
property FileName :
string read FFileName
write SetFileName;
end;
implementation
uses
Winapi.MMSystem, System.SysUtils;
{ TMciPlayer }
constructor TMciPlayer.Create;
begin
inherited Create;
FState := mpsClosed;
FAlias := GUIDToString( TGUID.NewGuid );
FFileName := '
';
FDuration := 0;
end;
destructor TMciPlayer.Destroy;
begin
DoClose;
inherited;
end;
procedure TMciPlayer.DoCallCommand(
const CmdStr :
string );
var
ResultStr :
string;
begin
DoCallCommand( CmdStr, ResultStr );
end;
procedure TMciPlayer.DoCallCommand(
const CmdStr :
string;
out ResultStr :
string );
var
lResultCode : Cardinal;
lResultSize : Cardinal;
lReturn :
array [0 .. 255]
of WideChar;
begin
lResultSize := 255;
lResultCode := mciSendString( PWideChar( CmdStr ), lReturn, lResultSize, 0 );
if lResultCode <> 0
then
begin
mciGetErrorString( lResultCode, lReturn, 255 );
raise Exception.CreateFmt( '
MCI-Fehler [%d] %s' + sLineBreak + '
%s', [lResultCode, lReturn, CmdStr] );
end;
ResultStr := lReturn;
end;
procedure TMciPlayer.DoClose;
begin
if State <> mpsClosed
then
begin
DoCallCommand( '
close ' + FAlias + '
wait' );
SetState( mpsClosed );
end;
end;
procedure TMciPlayer.DoOpen;
var
ResultStr :
string;
begin
if ( State = mpsClosed )
and ( FileName <> '
' )
and ( Alias <> '
' )
then
begin
FDuration := 0;
DoCallCommand( '
open "' + FFileName + '
" alias ' + FAlias );
DoCallCommand( '
set ' + FAlias + '
time format milliseconds wait' );
DoCallCommand( '
status ' + FAlias + '
length wait', ResultStr );
FDuration := StrToIntDef( ResultStr, 0 );
SetState( mpsStopped );
end;
end;
function TMciPlayer.GetPosition : Integer;
var
ResultStr :
string;
begin
if State <> mpsClosed
then
begin
DoCallCommand( '
status ' + FAlias + '
position wait', ResultStr );
Result := StrToIntDef( ResultStr, 0 );
end
else
Result := -1;
end;
function TMciPlayer.GetState : TMciPlayerState;
begin
Result := FState;
end;
procedure TMciPlayer.Open(
const aFileName :
string; aAutoPlay : Boolean );
begin
FileName := aFileName;
if aAutoPlay
then
Play;
end;
procedure TMciPlayer.Pause;
begin
if State = mpsPlaying
then
begin
DoCallCommand( '
pause ' + FAlias + '
notify' );
SetState( mpsPaused );
end;
end;
procedure TMciPlayer.Play;
begin
DoOpen;
case State
of
mpsStopped :
begin
DoCallCommand( '
play ' + FAlias + '
notify' );
SetState( mpsPlaying );
end;
mpsPaused :
Resume;
end;
end;
procedure TMciPlayer.Resume;
begin
if State = mpsPaused
then
begin
DoCallCommand( '
resume ' + FAlias + '
notify' );
SetState( mpsPlaying );
end;
end;
procedure TMciPlayer.SetFileName(
const Value :
string );
begin
if Value <> FFileName
then
begin
DoClose;
FFileName := Value;
end;
end;
procedure TMciPlayer.SetState(
const Value : TMciPlayerState );
begin
if Value <> FState
then
begin
FState := Value;
end;
end;
procedure TMciPlayer.Stop;
begin
if State > mpsStopped
then
begin
DoCallCommand( '
stop ' + FAlias + '
notify' );
SetState( mpsStopped );
DoCallCommand( '
seek ' + FAlias + '
to start notify' );
end;
end;
end.