Subversion Repositories general

Compare Revisions

Ignore whitespace Rev 1077 → Rev 1078

/Delphi/akMediaAdmin/Source/MPlayerUnit.pas
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.