{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 1995-2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit MPlayer;

{$R-,T-,H+,X+}

interface

uses Windows, Classes, Messages, 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);
  TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking,
    mpPaused, mpOpen);
  TMPNotifyValues = (nvSuccessful, nvSuperseded, nvAborted, nvFailure);
    
  TMPDevCaps = (mpCanStep, mpCanEject, mpCanPlay, mpCanRecord, mpUsesWindow);
  TMPDevCapsSet = set of TMPDevCaps;

  EMCIDeviceError = class(Exception);
  
  TMediaPlayer = class(TComponent)
  private
    Pressed: Boolean;
    Down: Boolean;
    CurrentRect: TRect;
    ButtonWidth: Integer;
    MinBtnSize: TPoint;
    MCIOpened: Boolean;
    FCapabilities: TMPDevCapsSet;
    FCanPlay: Boolean;
    FCanStep: Boolean;
    FCanEject: Boolean;
    FCanRecord: Boolean;
    FHasVideo: Boolean;
    FFlags: Longint;
    FWait: Boolean;
    FNotify: Boolean;
    FUseWait: Boolean;
    FUseNotify: Boolean;
    FUseFrom: Boolean;
    FUseTo: Boolean;
    FDeviceID: Word;
    FDeviceType: TMPDeviceTypes;
    FTo: Longint;
    FFrom: Longint;
    FFrames: Longint;
    FError: Longint;
    FNotifyValue: TMPNotifyValues;
    FDWidth: Integer;
    FDHeight: Integer;
    FElementName: string;
    FAutoEnable: Boolean;
    FAutoOpen: Boolean;
    FAutoRewind: Boolean;
    FShareable: Boolean;

    procedure CheckIfOpen;
    procedure SetPosition(Value: Longint);
    procedure SetDeviceType( Value: TMPDeviceTypes );
    procedure SetWait( Flag: Boolean );
    procedure SetNotify( Flag: Boolean );
    procedure SetFrom( Value: Longint );
    procedure SetTo( Value: Longint );
    procedure SetTimeFormat( Value: TMPTimeFormats );
    procedure SetOrigDisplay;
    procedure SetDisplayRect( Value: TRect );
    function GetDisplayRect: TRect;
    procedure GetDeviceCaps;
    function GetStart: Longint;
    function GetLength: Longint;
    function GetMode: TMPModes;
    function GetTracks: Longint;
    function GetPosition: Longint;
    function GetErrorMessage: string;
    function GetTimeFormat: TMPTimeFormats;
    function GetTrackLength(TrackNum: Integer): Longint;
    function GetTrackPosition(TrackNum: Integer): Longint;
  protected

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure Play;
    procedure Stop;
    procedure Pause; {Pause & Resume/Play}
    procedure Step;
    procedure Back;
    procedure Previous;
    procedure Next;
    procedure StartRecording;
    procedure Eject;
    procedure Save;
    procedure PauseOnly;
    procedure Resume;
    procedure Rewind;
    property TrackLength[TrackNum: Integer]: Longint read GetTrackLength;
    property TrackPosition[TrackNum: Integer]: Longint read GetTrackPosition;
    property Capabilities: TMPDevCapsSet read FCapabilities;
    property Error: Longint read FError;
    property ErrorMessage: string read GetErrorMessage;
    property Start: Longint read GetStart;
    property Length: Longint read GetLength;
    property Tracks: Longint read GetTracks;
    property Frames: Longint read FFrames write FFrames;
    property Mode: TMPModes read GetMode;
    property Position: Longint read GetPosition write SetPosition;
    property Wait: Boolean read FWait write SetWait;
    property Notify: Boolean read FNotify write SetNotify;
    property NotifyValue: TMPNotifyValues read FNotifyValue;
    property StartPos: Longint read FFrom write SetFrom;
    property EndPos: Longint read FTo write SetTo;
    property DeviceID: Word read FDeviceID;
    property TimeFormat: TMPTimeFormats read GetTimeFormat write SetTimeFormat;
    property DisplayRect: TRect read GetDisplayRect write SetDisplayRect;
  published
    property DeviceType: TMPDeviceTypes read FDeviceType write SetDeviceType default dtAutoSelect;
    property FileName: string read FElementName write FElementName;
    property Shareable: Boolean read FShareable write FShareable default False;
  end;

implementation

uses Consts;

const
  mci_Back     = $0899;  { mci_Step reverse }

Var
  Handle : HWnd;


constructor TMediaPlayer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDeviceType := dtAutoSelect; {select through file name extension}
end;

destructor TMediaPlayer.Destroy;
var
  GenParm: TMCI_Generic_Parms;
begin
  if FDeviceID <> 0 then
    mciSendCommand( FDeviceID, mci_Close, mci_Wait, Longint(@GenParm));
  inherited Destroy;
end;



{for MCI Commands to make sure device is open, else raise exception}
procedure TMediaPlayer.CheckIfOpen;
begin
  if not MCIOpened then{ raise EMCIDeviceError.CreateRes(@sNotOpenErr)};
end;


{***** MCI Commands *****}

procedure TMediaPlayer.Open;
const
  DeviceName: array[TMPDeviceTypes] of PChar = ('', 'AVIVideo', 'CDAudio', 'DAT',
    'DigitalVideo', 'MMMovie', 'Other', 'Overlay', 'Scanner', 'Sequencer',
    'VCR', 'Videodisc', 'WaveAudio');
var
  OpenParm: TMCI_Open_Parms;
  DisplayR: TRect;
begin
  { zero out memory }
  FillChar(OpenParm, SizeOf(TMCI_Open_Parms), 0);
  if MCIOpened then Close; {must close MCI Device first before opening another}

  OpenParm.dwCallback := 0;
  OpenParm.lpstrDeviceType := DeviceName[FDeviceType];
  OpenParm.lpstrElementName := PChar(FElementName);

  FFlags := 0;

  if FUseWait then
  begin
    if FWait then FFlags := mci_Wait;
    FUseWait := False;
  end
  else 
    FFlags := mci_Wait;

  if FUseNotify then
  begin
    if FNotify then FFlags := FFlags or mci_Notify;
    FUseNotify := False;
  end;

  if FDeviceType <> dtAutoSelect then
    FFlags := FFlags or mci_Open_Type;

  if FDeviceType <> dtAutoSelect then
    FFlags := FFlags or mci_Open_Type
  else
    FFlags := FFlags or MCI_OPEN_ELEMENT;

  if FShareable then
    FFlags := FFlags or mci_Open_Shareable;
  OpenParm.dwCallback := Handle;

  FError := mciSendCommand(0, mci_Open, FFlags, Longint(@OpenParm));

  if FError <> 0 then {problem opening device}
    raise EMCIDeviceError.Create(ErrorMessage)
  else {device successfully opened}
  begin
    MCIOpened := True;
    FDeviceID := OpenParm.wDeviceID;
    FFrames := Length div 10;  {default frames to step = 10% of total frames}
    GetDeviceCaps; {must first get device capabilities}
    if FHasVideo then {used for video output positioning}
    begin
      FDWidth := DisplayR.Right-DisplayR.Left;
      FDHeight := DisplayR.Bottom-DisplayR.Top;
    end;
    if (FDeviceType = dtCDAudio) or (FDeviceType = dtVideodisc) then
      TimeFormat := tfTMSF; {set timeformat to use tracks}
  End;
end;

procedure TMediaPlayer.Close;
var
  GenParm: TMCI_Generic_Parms;
begin
  if FDeviceID <> 0 then
  begin
    FFlags := 0;
    if FUseWait then
    begin
      if FWait then FFlags := mci_Wait;
      FUseWait := False;
    end
    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    GenParm.dwCallback := 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 TMediaPlayer.Play;
var
  PlayParm: TMCI_Play_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  {if at the end of media, and not using StartPos or EndPos - go to start}
  if FAutoRewind and (Position = Length) then
    if not FUseFrom and not FUseTo then Rewind;

  FFlags := 0;
  if FUseNotify then
  begin
    if FNotify then FFlags := mci_Notify;
    FUseNotify := False;
  end else FFlags := mci_Notify;
  if FUseWait then
  begin
    if FWait then FFlags := FFlags or mci_Wait;
    FUseWait := False;
  end;
  if FUseFrom then
  begin
    FFlags := FFlags or mci_From;
    PlayParm.dwFrom := FFrom;
    FUseFrom := False; {only applies to this mciSendCommand}
  end;
  if FUseTo then
  begin
    FFlags := FFlags or mci_To;
    PlayParm.dwTo := FTo;
    FUseTo := False; {only applies to this mciSendCommand}
  end;
  PlayParm.dwCallback := Handle;
  FError := mciSendCommand( FDeviceID, mci_Play, FFlags, Longint(@PlayParm));
end;

procedure TMediaPlayer.StartRecording;
var
  RecordParm: TMCI_Record_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  FFlags := 0;
  if FUseNotify then
  begin
    if FNotify then FFlags := mci_Notify;
    FUseNotify := False;
  end
  else FFlags := mci_Notify;
  if FUseWait then
  begin
    if FWait then FFlags := FFlags or mci_Wait;
    FUseWait := False;
  end;

  if FUseFrom then
  begin
    FFlags := FFlags or mci_From;
    RecordParm.dwFrom := FFrom;
    FUseFrom := False;
  end;
  if FUseTo then
  begin
    FFlags := FFlags or mci_To;
    RecordParm.dwTo := FTo;
    FUseTo := False;
  end;
  RecordParm.dwCallback := Handle;
  FError := mciSendCommand( FDeviceID, mci_Record, FFlags, Longint(@RecordParm));
end;

procedure TMediaPlayer.Stop;
var
  GenParm: TMCI_Generic_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  FFlags := 0;
  if FUseWait then
  begin
    if FWait then FFlags := mci_Wait;
    FUseWait := False;
  end
  else FFlags := mci_Wait;
  if FUseNotify then
  begin
    if FNotify then FFlags := FFlags or mci_Notify;
    FUseNotify := False;
  end;
  GenParm.dwCallback := Handle;
  FError := mciSendCommand( FDeviceID, mci_Stop, FFlags, Longint(@GenParm));
end;

procedure TMediaPlayer.Pause;
begin
  if not MCIOpened then Raise EMCIDeviceError.CreateRes(@sNotOpenErr);
  if Mode = mpPlaying then PauseOnly
  else
   if Mode = mpPaused then Resume;
end;

procedure TMediaPlayer.PauseOnly;
var
  GenParm: TMCI_Generic_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  FFlags := 0;
  if FUseWait then
  begin
    if FWait then FFlags := mci_Wait;
    FUseWait := False;
  end
  else FFlags := mci_Wait;
  if FUseNotify then
  begin
    if FNotify then FFlags := FFlags or mci_Notify;
    FUseNotify := False;
  end;
  GenParm.dwCallback := Handle;
  FError := mciSendCommand( FDeviceID, mci_Pause, FFlags, Longint(@GenParm));
end;

procedure TMediaPlayer.Resume;
var
  GenParm: TMCI_Generic_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  FFlags := 0;
  if FUseNotify then
  begin
    if FNotify then FFlags := mci_Notify;
  end
  else FFlags := mci_Notify;
  if FUseWait then
  begin
    if FWait then FFlags := FFlags or mci_Wait;
  end;
  GenParm.dwCallback := Handle;
  FError := mciSendCommand( FDeviceID, mci_Resume, FFlags, Longint(@GenParm));
  
  {if error calling resume (resume not supported),  call Play}
  if FError <> 0 then
    Play {FUseNotify & FUseWait reset by Play}
  else
  begin
    if FUseNotify then
      FUseNotify := False;
    if FUseWait then
      FUseWait := False;
  end;
end;

procedure TMediaPlayer.Next;
var
  SeekParm: TMCI_Seek_Parms;
  TempFlags: Longint;
begin
  CheckIfOpen; {raises exception if device is not open}

  FFlags := 0;
  if FUseWait then
  begin
    if FWait then FFlags := mci_Wait;
    FUseWait := False;
  end
  else FFlags := mci_Wait;
  if FUseNotify then
  begin
    if FNotify then FFlags := FFlags or mci_Notify;
    FUseNotify := False;
  end;

  TempFlags := FFlags; {preserve FFlags from GetTimeFormat & GetPosition}
  if TimeFormat = tfTMSF then {using Tracks}
  begin
    if Mode = mpPlaying then 
    begin
      if mci_TMSF_Track(Position) = Tracks then {if at last track}
         StartPos := GetTrackPosition(Tracks) {go to beg of last}
      else {go to next track}
         StartPos := GetTrackPosition((mci_TMSF_Track(Position))+1);
      Play;
      Exit;
    end
    else
    begin
      if mci_TMSF_Track(Position) = Tracks then {if at last track}
         SeekParm.dwTo := GetTrackPosition(Tracks) {go to beg of last}
      else {go to next track}
         SeekParm.dwTo := GetTrackPosition((mci_TMSF_Track(Position))+1);
      FFlags := TempFlags or mci_To;
    end;
  end
  else
    FFlags := TempFlags or mci_Seek_To_End;
    
  SeekParm.dwCallback := Handle;
  FError := mciSendCommand( FDeviceID, mci_Seek, FFlags, Longint(@SeekParm));
end; {Next}


procedure TMediaPlayer.Previous;
var
  SeekParm: TMCI_Seek_Parms;
  tpos,cpos,TempFlags: Longint;
begin
  CheckIfOpen; {raises exception if device is not open}

  FFlags := 0;
  if FUseWait then
  begin
    if FWait then FFlags := mci_Wait;
    FUseWait := False;
  end
  else FFlags := mci_Wait;
  if FUseNotify then
  begin
    if FNotify then FFlags := FFlags or mci_Notify;
    FUseNotify := False;
  end;

  TempFlags := FFlags; {preserve FFlags from GetTimeFormat & GetPosition}
  if TimeFormat = tfTMSF then {using Tracks}
  begin
    cpos := Position;
    tpos := GetTrackPosition(mci_TMSF_Track(Position));
    if Mode = mpPlaying then
    begin
      {if not on first track, and at beginning of current track}
      if (mci_TMSF_Track(cpos) <> 1) and
         (mci_TMSF_Minute(cpos) = mci_TMSF_Minute(tpos)) and
         (mci_TMSF_Second(cpos) = mci_TMSF_Second(tpos)) then
        StartPos := GetTrackPosition(mci_TMSF_Track(Position)-1) {go to previous}
      else
        StartPos := tpos; {otherwise, go to beginning of current}
      Play;
      Exit;
    end
    else
    begin
      {if not on first track, and at beginning of current track}
      if (mci_TMSF_Track(cpos) <> 1) and
         (mci_TMSF_Minute(cpos) = mci_TMSF_Minute(tpos)) and
         (mci_TMSF_Second(cpos) = mci_TMSF_Second(tpos)) then
        SeekParm.dwTo := GetTrackPosition(mci_TMSF_Track(Position)-1) {go to previous}
      else
         SeekParm.dwTo := tpos; {otherwise, go to beginning of current}
      FFlags := TempFlags or mci_To;
    end;
  end
  else
    FFlags := TempFlags or mci_Seek_To_Start;

  SeekParm.dwCallback := Handle;
  FError := mciSendCommand( FDeviceID, mci_Seek, FFlags, Longint(@SeekParm));
end; {Previous}

procedure TMediaPlayer.Step;
var
  AStepParm: TMCI_Anim_Step_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  if FHasVideo then
  begin
    if FAutoRewind and (Position = Length) then Rewind;

    FFlags := 0;
    if FUseWait then
    begin
      if FWait then FFlags := mci_Wait;
      FUseWait := False;
    end
    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    FFlags := FFlags or mci_Anim_Step_Frames;
    AStepParm.dwFrames := FFrames;
    AStepParm.dwCallback := Handle;
    FError := mciSendCommand( FDeviceID, mci_Step, FFlags, Longint(@AStepParm) );
  end; {if HasVideo}
end;

procedure TMediaPlayer.Back;
var
  AStepParm: TMCI_Anim_Step_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  if FHasVideo then
  begin
    FFlags := 0;
    if FUseWait then
    begin
      if FWait then FFlags := mci_Wait;
      FUseWait := False;
    end
    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    FFlags := FFlags or mci_Anim_Step_Frames or mci_Anim_Step_Reverse;
    AStepParm.dwFrames := FFrames;
    AStepParm.dwCallback := Handle;
    FError := mciSendCommand( FDeviceID, mci_Step, FFlags, Longint(@AStepParm) );
  end; {if HasVideo}
end; {Back}

procedure TMediaPlayer.Eject;
var
  SetParm: TMCI_Set_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  if FCanEject then
  begin
    FFlags := 0;
    if FUseWait then
    begin
      if FWait then FFlags := mci_Wait;
      FUseWait := False;
    end
    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    FFlags := FFlags or mci_Set_Door_Open;
    SetParm.dwCallback := Handle;
    FError := mciSendCommand( FDeviceID, mci_Set, FFlags, Longint(@SetParm) );
  end; {if CanEject}
end; {Eject}

procedure TMediaPlayer.SetPosition(Value: Longint);
var
  SeekParm: TMCI_Seek_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  FFlags := 0;
  if FUseWait then
  begin
    if FWait then FFlags := mci_Wait;
    FUseWait := False;
  end
  else FFlags := mci_Wait;
  if FUseNotify then
  begin
    if FNotify then FFlags := FFlags or mci_Notify;
    FUseNotify := False;
  end;
  FFlags := FFlags or mci_To;
  SeekParm.dwCallback := Handle;
  SeekParm.dwTo := Value;
  FError := mciSendCommand( FDeviceID, mci_Seek, FFlags, Longint(@SeekParm));
end;

procedure TMediaPlayer.Rewind;
var
  SeekParm: TMCI_Seek_Parms;
  RFlags: Longint;
begin
  CheckIfOpen; {raises exception if device is not open}
  RFlags := mci_Wait or mci_Seek_To_Start;
  mciSendCommand( FDeviceID, mci_Seek, RFlags, Longint(@SeekParm));
end;

function TMediaPlayer.GetTrackLength(TrackNum: Integer): Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}
  FFlags := mci_Wait or mci_Status_Item or mci_Track;
  StatusParm.dwItem := mci_Status_Length;
  StatusParm.dwTrack := Longint(TrackNum);
  mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.GetTrackPosition(TrackNum: Integer): Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  FFlags := mci_Wait or mci_Status_Item or mci_Track;
  StatusParm.dwItem := mci_Status_Position;
  StatusParm.dwTrack := Longint(TrackNum);
  mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

procedure TMediaPlayer.Save;
var
  SaveParm: TMCI_SaveParms;
begin
  CheckIfOpen; {raises exception if device is not open}
  if FElementName <> '' then {make sure a file has been specified to save to}
  begin
    SaveParm.lpfilename := PChar(FElementName);

    FFlags := 0;
    if FUseWait then
    begin
      if FWait then FFlags := mci_Wait;
      FUseWait := False;
    end
    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    SaveParm.dwCallback := Handle;
    FFlags := FFlags or mci_Save_File;
    FError := mciSendCommand(FDeviceID, mci_Save, FFlags, Longint(@SaveParm));
    end;
end;


{*** procedures that set control flags for MCI Commands ***}
procedure TMediaPlayer.SetWait( Flag: Boolean );
begin
  if Flag <> FWait then FWait := Flag;
  FUseWait := True;
end;

procedure TMediaPlayer.SetNotify( Flag: Boolean );
begin
  if Flag <> FNotify then FNotify := Flag;
  FUseNotify := True;
end;

procedure TMediaPlayer.SetFrom( Value: Longint );
begin
  if Value <> FFrom then FFrom := Value;
  FUseFrom := True;
end;

procedure TMediaPlayer.SetTo( Value: Longint );
begin
  if Value <> FTo then FTo := Value;
  FUseTo := True;
end;


procedure TMediaPlayer.SetDeviceType( Value: TMPDeviceTypes );
begin
  if Value <> FDeviceType then FDeviceType := Value;
end;

procedure TMediaPlayer.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;

{ special case to set video display back to original window,
  when FDisplay's TWinControl is deleted at runtime }
procedure TMediaPlayer.SetOrigDisplay;
var
  AWindowParm: TMCI_Anim_Window_Parms;
begin
  if MCIOpened and FHasVideo then
  begin
    FFlags := mci_Wait or mci_Anim_Window_hWnd;
    AWindowParm.Wnd := mci_Anim_Window_Default;
    FError := mciSendCommand( FDeviceID, mci_Window, FFlags, Longint(@AWindowParm) );
  end;
end;

{setting a rect for user-defined form to display video devices' output}
procedure TMediaPlayer.SetDisplayRect( Value: TRect );
var
  RectParms: TMCI_Anim_Rect_Parms;
  WorkR: TRect;
begin
  if MCIOpened and FHasVideo then
  begin
    {special case, use default width and height}
    if (Value.Bottom = 0) and (Value.Right = 0) then
    begin
      with Value do
        WorkR := Rect(Left, Top, FDWidth, FDHeight);
    end
    else WorkR := Value;
    FFlags := mci_Anim_RECT or mci_Anim_Put_Destination;
    RectParms.rc := WorkR;
    FError := mciSendCommand( FDeviceID, mci_Put, FFlags, Longint(@RectParms) );
  end;
end;


{***** functions to get device capabilities and status ***}

function TMediaPlayer.GetDisplayRect: TRect;
var
  RectParms: TMCI_Anim_Rect_Parms;
begin
  if MCIOpened and FHasVideo then
  begin
    FFlags := mci_Anim_Where_Destination;
    FError := mciSendCommand( FDeviceID, mci_Where, FFlags, Longint(@RectParms) );
    Result := RectParms.rc;
  end;
end;

{ fills in static properties upon opening MCI Device }
procedure TMediaPlayer.GetDeviceCaps;
var
  DevCapParm: TMCI_GetDevCaps_Parms;
  devType: Longint;
  RectParms: TMCI_Anim_Rect_Parms;
  WorkR: TRect;
begin
  FFlags := mci_Wait or mci_GetDevCaps_Item;

  DevCapParm.dwItem := mci_GetDevCaps_Can_Play;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  FCanPlay := Boolean(DevCapParm.dwReturn);
  if FCanPlay then Include(FCapabilities, mpCanPlay);

  DevCapParm.dwItem := mci_GetDevCaps_Can_Record;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  FCanRecord := Boolean(DevCapParm.dwReturn);
  if FCanRecord then Include(FCapabilities, mpCanRecord);

  DevCapParm.dwItem := mci_GetDevCaps_Can_Eject;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  FCanEject := Boolean(DevCapParm.dwReturn);
  if FCanEject then Include(FCapabilities, mpCanEject);

  DevCapParm.dwItem := mci_GetDevCaps_Has_Video;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  FHasVideo := Boolean(DevCapParm.dwReturn);
  if FHasVideo then Include(FCapabilities, mpUsesWindow);

  DevCapParm.dwItem := mci_GetDevCaps_Device_Type;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  devType := DevCapParm.dwReturn;
  if (devType = mci_DevType_Animation) or
     (devType = mci_DevType_Digital_Video) or
     (devType = mci_DevType_Overlay) or
     (devType = mci_DevType_VCR) then FCanStep := True;
  if FCanStep then Include(FCapabilities, mpCanStep);

  FFlags := mci_Anim_Where_Source;
  FError := mciSendCommand( FDeviceID, mci_Where, FFlags, Longint(@RectParms) );
  WorkR := RectParms.rc;
  FDWidth := WorkR.Right - WorkR.Left;
  FDHeight := WorkR.Bottom - WorkR.Top;
end; {GetDeviceCaps}

function TMediaPlayer.GetStart: Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}
  FFlags := mci_Wait or mci_Status_Item or mci_Status_Start;
  StatusParm.dwItem := mci_Status_Position;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.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;

function TMediaPlayer.GetTracks: 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_Number_Of_Tracks;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.GetMode: TMPModes;
var
  StatusParm: TMCI_Status_Parms;
begin
  FFlags := mci_Wait or mci_Status_Item;
  StatusParm.dwItem := mci_Status_Mode;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := TMPModes(StatusParm.dwReturn - 524); {MCI Mode #s are 524+enum}
end;

function TMediaPlayer.GetPosition: Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  FFlags := mci_Wait or mci_Status_Item;
  StatusParm.dwItem := mci_Status_Position;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.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;

function TMediaPlayer.GetErrorMessage: string;
var
  ErrMsg: array[0..4095] of Char;
begin
  if not mciGetErrorString(FError, ErrMsg, SizeOf(ErrMsg)) then
    Result := SMCIUnknownError
  else SetString(Result, ErrMsg, StrLen(ErrMsg));
end;

end.