{*******************************************************} { } { 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.