{*******************************************************}
{ }
{ Borland Delphi Visual Component Library }
{ }
{ Copyright (c) 1995-2005 Borland Software Corporation }
{ }
{*******************************************************}
unit MYMPlayer;
{$R-,T-,H+,X+}
interface
uses Windows, Classes, Controls, Forms, Graphics, Messages,
MMSystem, Dialogs, SysUtils;
type
TMPBtnType = (btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
btRecord, btEject);
TButtonSet = set of TMPBtnType;
TMPGlyph = (mgEnabled, mgDisabled, mgColored);
TMPButton = record
Visible: Boolean;
Enabled: Boolean;
Colored: Boolean;
Auto: Boolean;
Bitmaps: array[TMPGlyph] of TBitmap;
end;
TMPDeviceTypes = (dtAutoSelect, dtAVIVideo, dtCDAudio, dtDAT, dtDigitalVideo, dtMMMovie,
dtOther, dtOverlay, dtScanner, dtSequencer, dtVCR, dtVideodisc, dtWaveAudio, dtMPEGVideo);
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;
EMPNotify = procedure (Sender: TObject; Button: TMPBtnType;
var DoDefault: Boolean) of object;
EMPPostNotify = procedure (Sender: TObject; Button: TMPBtnType) of object;
EMCIDeviceError = class(Exception);
TMediaPlayer = class(TCustomControl)
private
Buttons: array[TMPBtnType] of TMPButton;
FVisibleButtons: TButtonSet;
FEnabledButtons: TButtonSet;
FColoredButtons: TButtonSet;
FAutoButtons: TButtonSet;
Pressed: Boolean;
Down: Boolean;
CurrentButton: TMPBtnType;
CurrentRect: TRect;
ButtonWidth: Integer;
MinBtnSize: TPoint;
FOnClick: EMPNotify;
FOnPostClick: EMPPostNotify;
FOnNotify: TNotifyEvent;
FocusedButton: TMPBtnType;
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;
FDisplay: TWinControl;
FDWidth: Integer;
FDHeight: Integer;
FElementName: string;
FAutoEnable: Boolean;
FAutoOpen: Boolean;
FAutoRewind: Boolean;
FShareable: Boolean;
procedure LoadBitmaps;
procedure DestroyBitmaps;
procedure SetEnabledButtons(Value: TButtonSet);
procedure SetColored(Value: TButtonSet);
procedure SetVisible(Value: TButtonSet);
procedure SetAutoEnable(Value: Boolean);
procedure DrawAutoButtons;
procedure DoMouseDown(XPos, YPos: Integer);
procedure WMLButtonDown(var Message: TWMLButtonDown);
message WM_LButtonDown;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
message WM_LButtonDblClk;
procedure WMMouseMove(var Message: TWMMouseMove);
message WM_MouseMove;
procedure WMLButtonUp(var Message: TWMLButtonUp);
message WM_LButtonUp;
procedure WMSetFocus(var Message: TWMSetFocus);
message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus);
message WM_KILLFOCUS;
procedure WMGetDlgCode(var Message: TWMGetDlgCode);
message WM_GETDLGCODE;
procedure WMSize(var Message: TWMSize);
message WM_SIZE;
function VisibleButtonCount: Integer;
procedure Adjust;
procedure DoClick(Button: TMPBtnType);
procedure DoPostClick(Button: TMPBtnType);
procedure DrawButton(Btn: TMPBtnType; X: Integer);
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 SetDisplay( Value: TWinControl );
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
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Loaded; override;
procedure AutoButtonSet(Btn: TMPBtnType); dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Paint; override;
procedure MMNotify(var Message: TMessage); message MM_MCINOTIFY;
procedure Click(Button: TMPBtnType; var DoDefault: Boolean); reintroduce; dynamic;
procedure PostClick(Button: TMPBtnType); dynamic;
procedure DoNotify; dynamic;
procedure Updated; override;
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 ColoredButtons: TButtonSet read FColoredButtons write SetColored
default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
btRecord, btEject];
property Enabled;
property EnabledButtons: TButtonSet read FEnabledButtons write SetEnabledButtons
default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
btRecord, btEject];
property VisibleButtons: TButtonSet read FVisibleButtons write SetVisible
default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
btRecord, btEject];
property Anchors;
property AutoEnable: Boolean read FAutoEnable write SetAutoEnable default True;
property AutoOpen: Boolean read FAutoOpen write FAutoOpen default False;
property AutoRewind: Boolean read FAutoRewind write FAutoRewind default True;
property Constraints;
property DeviceType: TMPDeviceTypes read FDeviceType write SetDeviceType default dtAutoSelect;
property Display: TWinControl read FDisplay write SetDisplay;
property FileName: string read FElementName write FElementName;
property Shareable: Boolean read FShareable write FShareable default False;
property Visible;
property ParentShowHint;
property ShowHint;
property PopupMenu;
property TabOrder;
property TabStop default True;
property OnClick: EMPNotify read FOnClick write FOnClick;
property OnContextPopup;
property OnEnter;
property OnExit;
property OnMouseEnter;
property OnMouseLeave;
property OnPostClick: EMPPostNotify read FOnPostClick write FOnPostClick;
property OnNotify: TNotifyEvent read FOnNotify write FOnNotify;
end;
implementation
uses Consts;
{$R MPlayer.res}
const
mci_Back = 99; { mci_Step reverse }
BtnStateName: array[TMPGlyph] of PChar = ('EN', 'DI', 'CL');
BtnTypeName: array[TMPBtnType] of PChar = ('MPPLAY', 'MPPAUSE', 'MPSTOP',
'MPNEXT', 'MPPREV', 'MPSTEP', 'MPBACK', 'MPRECORD', 'MPEJECT');
constructor TMediaPlayer.Create(AOwner: TComponent);
var
I: TMPBtnType;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
LoadBitmaps;
FVisibleButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
btBack, btRecord, btEject];
FEnabledButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
btBack, btRecord, btEject];
FColoredButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
btBack, btRecord, btEject];
for I := Low(Buttons) to High(Buttons) do
begin
Buttons[I].Visible := True;
Buttons[I].Enabled := True;
Buttons[I].Colored := True;
Buttons[I].Auto := False; {enabled/disabled dynamically}
end;
Width := 240;
Height := 30;
FocusedButton := btPlay;
FAutoEnable := True;
FAutoOpen := False;
FAutoRewind := True;
FDeviceType := dtAutoSelect; {select through file name extension}
TabStop := True;
end;
destructor TMediaPlayer.Destroy;
var
GenParm: TMCI_Generic_Parms;
begin
if FDeviceID <> 0 then
mciSendCommand( FDeviceID, mci_Close, mci_Wait, Longint(@GenParm));
DestroyBitmaps;
inherited Destroy;
end;
procedure TMediaPlayer.Loaded;
begin
inherited Loaded;
if (not (csDesigning in ComponentState)) and FAutoOpen then
Open;
end;
procedure TMediaPlayer.LoadBitmaps;
var
I: TMPBtnType;
J: TMPGlyph;
ResName: array[0..40] of Char;
begin
MinBtnSize := Point(0, 0);
for I := Low(Buttons) to High(Buttons) do
begin
for J := Low(TMPGlyph) to High(TMPGlyph) do
begin
Buttons[I].Bitmaps[J] := TBitmap.Create;
Buttons[I].Bitmaps[J].Handle := LoadBitmap(HInstance,
StrFmt(ResName, '%s_%s', [BtnStateName[J], BtnTypeName[I]]));
if MinBtnSize.X < Buttons[I].Bitmaps[J].Width then
MinBtnSize.X := Buttons[I].Bitmaps[J].Width;
if MinBtnSize.Y < Buttons[I].Bitmaps[J].Height then
MinBtnSize.Y := Buttons[I].Bitmaps[J].Height;
end;
end;
Inc(MinBtnSize.X, 2 * 4);
Inc(MinBtnSize.Y, 2 * 2);
end;
procedure TMediaPlayer.DestroyBitmaps;
var
I: TMPBtnType;
J: TMPGlyph;
begin
for I := Low(Buttons) to High(Buttons) do
for J := Low(TMPGlyph) to High(TMPGlyph) do
Buttons[I].Bitmaps[J].Free;
end;
procedure TMediaPlayer.SetAutoEnable(Value: Boolean);
begin
if Value <> FAutoEnable then
begin
FAutoEnable := Value;
if FAutoEnable then
DrawAutoButtons {paint buttons based on current state of device}
else
SetEnabledButtons(FEnabledButtons); {paint buttons based on Enabled}
end;
end;
procedure TMediaPlayer.SetEnabledButtons(Value: TButtonSet);
var
I: TMPBtnType;
begin
FEnabledButtons := Value;
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Enabled := I in FEnabledButtons;
Invalidate;
end;
procedure TMediaPlayer.DrawAutoButtons;
var
I: TMPBtnType;
begin
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Auto := I in FAutoButtons;
Invalidate;
end;
procedure TMediaPlayer.SetColored(Value: TButtonSet);
var
I: TMPBtnType;
begin
FColoredButtons := Value;
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Colored := I in FColoredButtons;
Invalidate;
end;
procedure TMediaPlayer.SetVisible(Value: TButtonSet);
var
I: TMPBtnType;
begin
FVisibleButtons := Value;
for I := Low(Buttons) to High(Buttons) do
Buttons[I].Visible := I in FVisibleButtons;
if csUpdating in ComponentState then
begin
ButtonWidth := ((Width - 1) div VisibleButtonCount) + 1;
Invalidate;
end
else Adjust;
end;
function TMediaPlayer.VisibleButtonCount: Integer;
var
I: TMPBtnType;
begin
Result := 0;
for I := Low(Buttons) to High(Buttons) do
if Buttons[I].Visible then Inc(Result);
if Result = 0 then Inc(Result);
end;
procedure TMediaPlayer.Adjust;
var
Count: Integer;
begin
Count := VisibleButtonCount;
Width := Count * (ButtonWidth - 1) + 1;
Invalidate;
end;
procedure TMediaPlayer.WMSize(var Message: TWMSize);
var
Count: Integer;
MinSize: TPoint;
W, H: Integer;
begin
inherited;
if not (csUpdating in ComponentState) then
begin
{ check for minimum size }
Count := VisibleButtonCount;
MinSize.X := Count * (MinBtnSize.X - 1) + 1;
MinSize.Y := MinBtnSize.Y;
ButtonWidth := ((Width - 1) div Count) + 1;
W := Count * (ButtonWidth - 1) + 1;
if W < MinSize.X then W := MinSize.X;
if Height < MinSize.Y then H := MinSize.Y
else H := Height;
if (W <> Width) or (H <> Height) then
SetBounds(Left, Top, W, H);
Message.Result := 0;
end;
end;
procedure TMediaPlayer.DrawButton(Btn: TMPBtnType; X: Integer);
var
IsDown: Boolean;
BX, BY: Integer;
TheGlyph: TMPGlyph;
Bitmap: TBitmap;
R: TRect;
begin
IsDown := Down and (Btn = CurrentButton);
with Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clBtnFace;
Pen.Color := clWindowFrame;
Pen.Width := 1;
Rectangle(X, 0, X + ButtonWidth, Height);
{ draw button beveling }
if IsDown then
begin
Pen.Color := clBtnShadow;
MoveTo(X + 1, Height - 2);
LineTo(X + 1, 1);
LineTo(X + ButtonWidth - 1, 1);
end
else
begin
Pen.Color := clBtnHighlight;
MoveTo(X + 1, Height - 2);
LineTo(X + 1, 1);
LineTo(X + ButtonWidth - 1, 1);
Pen.Color := clBtnShadow;
MoveTo(X + 2, Height - 2);
LineTo(X + ButtonWidth - 2, Height - 2);
LineTo(X + ButtonWidth - 2, 1);
end;
{which bitmap logic - based on Enabled, Colored, and AutoEnable}
if Enabled or (csDesigning in ComponentState) then
begin {Enabled only affects buttons at runtime}
if FAutoEnable and not (csDesigning in ComponentState) then
begin {AutoEnable only affects buttons at runtime}
if Buttons[Btn].Auto then {is button available, based on device state}
begin
TheGlyph := mgEnabled;
if Buttons[Btn].Colored then
TheGlyph := mgColored;
end
else TheGlyph := mgDisabled; {button is not available}
end
else {when not AutoEnabled or at design-time, check Enabled}
begin
if Buttons[Btn].Enabled then
begin
TheGlyph := mgEnabled;
if Buttons[Btn].Colored then
TheGlyph := mgColored;
end
else TheGlyph := mgDisabled;
end;
end
else TheGlyph := mgDisabled; {main switch set to disabled}
Bitmap := Buttons[Btn].Bitmaps[TheGlyph];
BX := (ButtonWidth div 2) - (Bitmap.Width div 2);
BY := (Height div 2) - (Bitmap.Height div 2);
if IsDown then
begin
Inc(BX);
Inc(BY);
end;
BrushCopy(Bounds(X + BX, BY, Bitmap.Width, Bitmap.Height),
Bitmap, Rect(0, 0, Bitmap.Width, Bitmap.Height), clOlive);
end;
if (GetFocus = Handle) and (Btn = FocusedButton) then
begin
R := Bounds(X, 0, ButtonWidth, Height);
InflateRect(R, -3, -3);
if IsDown then OffsetRect(R, 1, 1);
DrawFocusRect(Canvas.Handle, R);
end;
end;
procedure TMediaPlayer.Paint;
var
X: Integer;
I: TMPBtnType;
begin
with Canvas do
begin
Brush.Style := bsClear;
Pen.Color := clWindowFrame;
Pen.Width := 1;
Rectangle(0, 0, Width, Height);
X := 0;
for I := Low(Buttons) to High(Buttons) do
begin
if Buttons[I].Visible then
begin
DrawButton(I, X);
Inc(X, ButtonWidth - 1);
end;
end;
end;
end;
{AutoEnable=True, enable/disable button set based on button passed (pressed)}
procedure TMediaPlayer.AutoButtonSet(Btn: TMPBtnType);
begin
case Btn of
btPlay:
begin
FAutoButtons := FAutoButtons - [btPlay,btRecord];
FAutoButtons := FAutoButtons + [btStop,btPause];
end;
btPause:
begin
if FCanPlay then Include(FAutoButtons,btPlay);
if FCanRecord then Include(FAutoButtons,btRecord);
end;
btStop:
begin
if FCanPlay then Include(FAutoButtons,btPlay);
if FCanRecord then Include(FAutoButtons,btRecord);
FAutoButtons := FAutoButtons - [btStop,btPause];
end;
btNext:
begin
if FCanPlay then Include(FAutoButtons,btPlay);
if FCanRecord then Include(FAutoButtons,btRecord);
FAutoButtons := FAutoButtons - [btStop,btPause];
end;
btPrev:
begin
if FCanPlay then Include(FAutoButtons,btPlay);
if FCanRecord then Include(FAutoButtons,btRecord);
FAutoButtons := FAutoButtons - [btStop,btPause];
end;
btStep:
begin
if FCanPlay then Include(FAutoButtons,btPlay);
if FCanRecord then Include(FAutoButtons,btRecord);
FAutoButtons := FAutoButtons - [btStop,btPause];
end;
btBack:
begin
if FCanPlay then Include(FAutoButtons,btPlay);
if FCanRecord then Include(FAutoButtons,btRecord);
FAutoButtons := FAutoButtons - [btStop,btPause];
end;
btRecord:
begin
FAutoButtons := FAutoButtons - [btPlay,btRecord];
FAutoButtons := FAutoButtons + [btStop,btPause];
end;
btEject: {without polling no way to determine when CD is inserted}
begin
if FCanPlay then Include(FAutoButtons,btPlay);
if FCanRecord then Include(FAutoButtons,btRecord);
FAutoButtons := FAutoButtons - [btStop,btPause];
end;
end;
end;
procedure TMediaPlayer.DoMouseDown(XPos, YPos: Integer);
var
I: TMPBtnType;
X: Integer;
begin
{which button was clicked}
X := 0;
for I := Low(Buttons) to High(Buttons) do
begin
if Buttons[I].Visible then
begin
if (XPos >= X) and (XPos <= X + ButtonWidth) then
begin
if FAutoEnable then
if Buttons[I].Auto then Break
else Exit;
if Buttons[I].Enabled then Break
else Exit;
end;
Inc(X, ButtonWidth - 1);
end;
end;
CurrentButton := I;
if CurrentButton <> FocusedButton then
begin
FocusedButton := CurrentButton;
Paint;
end;
CurrentRect := Rect(X, 0, X + ButtonWidth, Height);
Pressed := True;
Down := True;
DrawButton(I, X);
MouseCapture := True;
end;
procedure TMediaPlayer.WMLButtonDown(var Message: TWMLButtonDown);
begin
DoMouseDown(Message.XPos, Message.YPos);
end;
procedure TMediaPlayer.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
DoMouseDown(Message.XPos, Message.YPos);
end;
procedure TMediaPlayer.WMMouseMove(var Message: TWMMouseMove);
var
P: TPoint;
begin
if Pressed then
begin
P := Point(Message.XPos, Message.YPos);
if PtInRect(CurrentRect, P) <> Down then
begin
Down := not Down;
DrawButton(CurrentButton, CurrentRect.Left);
end;
end;
end;
procedure TMediaPlayer.DoClick(Button: TMPBtnType);
var
DoDefault: Boolean;
begin
DoDefault := True;
Click(CurrentButton, DoDefault);
if DoDefault then
begin
case CurrentButton of
btPlay: Play;
btPause: Pause;
btStop: Stop;
btNext: Next;
btPrev: Previous;
btStep: Step;
btBack: Back;
btRecord: StartRecording;
btEject: Eject;
end;
DoPostClick(CurrentButton);
end;
end;
procedure TMediaPlayer.DoPostClick(Button: TMPBtnType);
begin
PostClick(CurrentButton);
end;
procedure TMediaPlayer.WMLButtonUp(var Message: TWMLButtonUp);
begin
MouseCapture := False;
if Pressed and Down then
begin
Down := False;
DrawButton(CurrentButton, CurrentRect.Left); {raise button before calling code}
DoClick(CurrentButton);
if FAutoEnable and (FError = 0) and MCIOpened then
begin
AutoButtonSet(CurrentButton);
DrawAutoButtons;
end;
end;
Pressed := False;
end;
procedure TMediaPlayer.WMSetFocus(var Message: TWMSetFocus);
begin
Paint;
end;
procedure TMediaPlayer.WMKillFocus(var Message: TWMKillFocus);
begin
Paint;
end;
procedure TMediaPlayer.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
Message.Result := DLGC_WANTARROWS;
end;
procedure TMediaPlayer.KeyDown(var Key: Word; Shift: TShiftState);
var
NewFocus: TMPBtnType;
begin
case Key of
VK_RIGHT:
begin
NewFocus := FocusedButton;
repeat
if NewFocus < High(Buttons) then
NewFocus := Succ(NewFocus);
until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible);
if NewFocus <> FocusedButton then
begin
FocusedButton := NewFocus;
Invalidate;
end;
end;
VK_LEFT:
begin
NewFocus := FocusedButton;
repeat
if NewFocus > Low(Buttons) then
NewFocus := Pred(NewFocus);
until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible);
if NewFocus <> FocusedButton then
begin
FocusedButton := NewFocus;
Invalidate;
end;
end;
VK_SPACE:
begin
if Buttons[FocusedButton].Enabled then
begin
CurrentButton := FocusedButton;
DoClick(CurrentButton);
if FAutoEnable then
begin
AutoButtonSet(CurrentButton);
DrawAutoButtons;
end;
end;
end;
end;
end;
{MCI message generated when Notify=True, and MCI command completes}
procedure TMediaPlayer.MMNotify(var Message: TMessage);
begin
if FAutoEnable and (Mode = mpStopped) then
begin {special AutoEnable case for when Play and Record finish}
if FCanPlay then Include(FAutoButtons,btPlay);
if FCanRecord then Include(FAutoButtons,btRecord);
FAutoButtons := FAutoButtons - [btStop,btPause];
DrawAutoButtons;
end;
case Message.WParam of
mci_Notify_Successful: FNotifyValue := nvSuccessful;
mci_Notify_Superseded: FNotifyValue := nvSuperseded;
mci_Notify_Aborted: FNotifyValue := nvAborted;
mci_Notify_Failure: FNotifyValue := nvFailure;
end;
DoNotify;
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;
procedure TMediaPlayer.Click(Button: TMPBtnType; var DoDefault: Boolean);
begin
if Assigned(FOnCLick) then FOnClick(Self, Button, DoDefault);
end;
procedure TMediaPlayer.PostClick(Button: TMPBtnType);
begin
if Assigned(FOnPostCLick) then FOnPostClick(Self, Button);
end;
procedure TMediaPlayer.DoNotify;
begin
if Assigned(FOnNotify) then FOnNotify(Self);
end;
procedure TMediaPlayer.Updated;
begin
inherited;
Adjust;
end;
{***** MCI Commands *****}
procedure TMediaPlayer.Open;
const
DeviceName: array[TMPDeviceTypes] of PChar = ('', 'AVIVideo', 'CDAudio', 'DAT',
'DigitalVideo', 'MMMovie', 'Other', 'Overlay', 'Scanner', 'Sequencer',
'VCR', 'Videodisc', 'WaveAudio', 'MPEGVideo');
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
Display := FDisplay; {if one was set in design mode}
DisplayR := GetDisplayRect;
FDWidth := DisplayR.Right-DisplayR.Left;
FDHeight := DisplayR.Bottom-DisplayR.Top;
end;
if (FDeviceType = dtCDAudio) or (FDeviceType = dtVideodisc) or (FDeviceType = dtMPEGVideo) then
TimeFormat := tfTMSF; {set timeformat to use tracks}
FAutoButtons := [btNext,btPrev]; {assumed all devices can seek to start, end}
if FCanStep then FAutoButtons := FAutoButtons + [btStep,btBack];
if FCanPlay then Include(FAutoButtons, btPlay);
if FCanRecord then Include(FAutoButtons, btRecord);
if FCanEject then Include(FAutoButtons, btEject);
if Mode = mpPlaying then AutoButtonSet(btPlay); {e.g. CD device}
DrawAutoButtons;
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;
FAutoButtons := [];
DrawAutoButtons;
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;
CurrentButton := btPlay;
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;
CurrentButton := btPlay;
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;
{setting a TWinControl to display video devices' output}
procedure TMediaPlayer.SetDisplay( Value: TWinControl );
var
AWindowParm: TMCI_Anim_Window_Parms;
begin
if (Value <> nil) and MCIOpened and FHasVideo then
begin
FFlags := mci_Wait or mci_Anim_Window_hWnd;
AWindowParm.Wnd := Longint(Value.Handle);
FError := mciSendCommand( FDeviceID, mci_Window, FFlags, Longint(@AWindowParm) );
if FError <> 0 then
FDisplay := nil {alternate window not supported}
else
begin
FDisplay := Value; {alternate window supported}
Value.FreeNotification(Self);
end;
end
else FDisplay := Value;
end;
procedure TMediaPlayer.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FDisplay) then
begin
if MCIOpened then SetOrigDisplay;
FDisplay := nil;
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.
