0,0 → 1,160 |
// akMediaAdmin v. 1.1 |
// Copyright (c) 1999-2000 Anatoli Klassen |
// Based on TMediaPlayer from Borland |
|
unit MPlayerUnit; |
|
interface |
|
uses MMSystem, SysUtils; |
|
type |
TMPDeviceTypes = (dtAutoSelect, dtAVIVideo, dtCDAudio, dtDAT, dtDigitalVideo, dtMMMovie, |
dtOther, dtOverlay, dtScanner, dtSequencer, dtVCR, dtVideodisc, dtWaveAudio); |
|
TMPTimeFormats = (tfMilliseconds, tfHMS, tfMSF, tfFrames, tfSMPTE24, tfSMPTE25, |
tfSMPTE30, tfSMPTE30Drop, tfBytes, tfSamples, tfTMSF); |
|
TPlayer = class |
private |
MCIOpened: Boolean; |
FDeviceID: Word; |
FDeviceType: TMPDeviceTypes; |
FElementName: string; |
FFlags: Longint; |
FError: Longint; |
function GetLength: Longint; |
procedure CheckIfOpen; |
procedure SetDeviceType(Value: TMPDeviceTypes); |
function GetTimeFormat: TMPTimeFormats; |
procedure SetTimeFormat(Value: TMPTimeFormats); |
public |
constructor Create; |
destructor Destroy; override; |
procedure Open; |
procedure Close; |
property Length: Longint read GetLength; |
property FileName: string read FElementName write FElementName; |
property DeviceType: TMPDeviceTypes read FDeviceType write SetDeviceType; |
property TimeFormat: TMPTimeFormats read GetTimeFormat write SetTimeFormat; |
end; |
|
EMCIDeviceError = class(Exception); |
|
implementation |
|
constructor TPlayer.Create; |
begin |
inherited Create; |
FDeviceType := dtAutoSelect; {select through file name extension} |
end; |
|
destructor TPlayer.Destroy; |
var |
GenParm: TMCI_Generic_Parms; |
|
begin |
if FDeviceID <> 0 then |
mciSendCommand(FDeviceID, mci_Close, mci_Wait, Longint(@GenParm)); |
inherited Destroy; |
end; |
|
procedure TPlayer.SetDeviceType(Value: TMPDeviceTypes); |
begin |
if Value <> FDeviceType then FDeviceType := Value; |
end; |
|
function TPlayer.GetTimeFormat: TMPTimeFormats; |
var |
StatusParm: TMCI_Status_Parms; |
begin |
CheckIfOpen; {raises exception if device is not open} |
FFlags := mci_Wait or mci_Status_Item; |
StatusParm.dwItem := mci_Status_Time_Format; |
FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm)); |
Result := TMPTimeFormats(StatusParm.dwReturn); |
end; |
|
procedure TPlayer.SetTimeFormat(Value: TMPTimeFormats); |
var |
SetParm: TMCI_Set_Parms; |
begin |
begin |
FFlags := mci_Notify or mci_Set_Time_Format; |
SetParm.dwTimeFormat := Longint(Value); |
FError := mciSendCommand( FDeviceID, mci_Set, FFlags, Longint(@SetParm) ); |
end; |
end; |
|
procedure TPlayer.Open; |
const |
DeviceName: array[TMPDeviceTypes] of PChar = ('', 'AVIVideo', 'CDAudio', 'DAT', |
'DigitalVideo', 'MMMovie', 'Other', 'Overlay', 'Scanner', 'Sequencer', |
'VCR', 'Videodisc', 'WaveAudio'); |
|
var |
OpenParm: TMCI_Open_Parms; |
|
begin |
{ zero out memory } |
FillChar(OpenParm, SizeOf(TMCI_Open_Parms), 0); |
if MCIOpened then Close; {must close MCI Device first before opening another} |
|
OpenParm.lpstrDeviceType := DeviceName[FDeviceType]; |
OpenParm.lpstrElementName := PChar(FElementName); |
|
FFlags := mci_Wait; |
|
if FDeviceType <> dtAutoSelect then |
FFlags := FFlags or mci_Open_Type |
else |
FFlags := FFlags or MCI_OPEN_ELEMENT; |
|
OpenParm.dwCallback := 0; //Handle; |
|
FError := mciSendCommand(0, mci_Open, FFlags, Longint(@OpenParm)); |
|
if FError <> 0 then {problem opening device} |
raise EMCIDeviceError.Create('Can not open file') |
else {device successfully opened} |
begin |
MCIOpened := True; |
FDeviceID := OpenParm.wDeviceID; |
end; |
end; |
|
procedure TPlayer.Close; |
var |
GenParm: TMCI_Generic_Parms; |
begin |
if FDeviceID <> 0 then |
begin |
FFlags := 0; |
FFlags := mci_Wait; |
GenParm.dwCallback := 0; //Handle; |
FError := mciSendCommand( FDeviceID, mci_Close, FFlags, Longint(@GenParm)); |
if FError = 0 then |
begin |
MCIOpened := False; |
FDeviceID := 0; |
end; |
end; {if DeviceID <> 0} |
end; |
|
procedure TPlayer.CheckIfOpen; |
begin |
if not MCIOpened then raise EMCIDeviceError.Create('Not open'); |
end; |
|
function TPlayer.GetLength: Longint; |
var |
StatusParm: TMCI_Status_Parms; |
begin |
CheckIfOpen; {raises exception if device is not open} |
FFlags := mci_Wait or mci_Status_Item; |
StatusParm.dwItem := mci_Status_Length; |
FError := mciSendCommand(FDeviceID, mci_Status, FFlags, Longint(@StatusParm)); |
Result := StatusParm.dwReturn; |
end; |
|
end. |