home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Vcl / mplayer.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  46KB  |  1,584 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit MPlayer;
  11.  
  12. {$R-,T-,H+,X+}
  13.  
  14. interface
  15.  
  16. uses Windows, Classes, Controls, Forms, Graphics, Messages,
  17.   MMSystem, Dialogs, SysUtils;
  18.  
  19. type
  20.   TMPBtnType = (btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
  21.     btRecord, btEject);
  22.   TButtonSet = set of TMPBtnType;
  23.  
  24.   TMPGlyph = (mgEnabled, mgDisabled, mgColored);
  25.   TMPButton = record
  26.     Visible: Boolean;
  27.     Enabled: Boolean;
  28.     Colored: Boolean;
  29.     Auto: Boolean;
  30.     Bitmaps: array[TMPGlyph] of TBitmap;
  31.   end;
  32.  
  33.   TMPDeviceTypes = (dtAutoSelect, dtAVIVideo, dtCDAudio, dtDAT, dtDigitalVideo, dtMMMovie,
  34.     dtOther, dtOverlay, dtScanner, dtSequencer, dtVCR, dtVideodisc, dtWaveAudio);
  35.   TMPTimeFormats = (tfMilliseconds, tfHMS, tfMSF, tfFrames, tfSMPTE24, tfSMPTE25,
  36.     tfSMPTE30, tfSMPTE30Drop, tfBytes, tfSamples, tfTMSF);
  37.   TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking,
  38.     mpPaused, mpOpen);
  39.   TMPNotifyValues = (nvSuccessful, nvSuperseded, nvAborted, nvFailure);
  40.     
  41.   TMPDevCaps = (mpCanStep, mpCanEject, mpCanPlay, mpCanRecord, mpUsesWindow);
  42.   TMPDevCapsSet = set of TMPDevCaps;
  43.   
  44.   EMPNotify = procedure (Sender: TObject; Button: TMPBtnType;
  45.     var DoDefault: Boolean) of object;
  46.   EMPPostNotify = procedure (Sender: TObject; Button: TMPBtnType) of object;
  47.  
  48.   EMCIDeviceError = class(Exception);
  49.   
  50.   TMediaPlayer = class(TCustomControl)
  51.   private
  52.     Buttons: array[TMPBtnType] of TMPButton;
  53.     FVisibleButtons: TButtonSet;
  54.     FEnabledButtons: TButtonSet;
  55.     FColoredButtons: TButtonSet;
  56.     FAutoButtons: TButtonSet;
  57.     Pressed: Boolean;
  58.     Down: Boolean;
  59.     CurrentButton: TMPBtnType;
  60.     CurrentRect: TRect;
  61.     ButtonWidth: Integer;
  62.     MinBtnSize: TPoint;
  63.     FOnClick: EMPNotify;
  64.     FOnPostClick: EMPPostNotify;
  65.     FOnNotify: TNotifyEvent;
  66.     FocusedButton: TMPBtnType;
  67.     MCIOpened: Boolean;
  68.     FCapabilities: TMPDevCapsSet;
  69.     FCanPlay: Boolean;
  70.     FCanStep: Boolean;
  71.     FCanEject: Boolean;
  72.     FCanRecord: Boolean;
  73.     FHasVideo: Boolean;
  74.     FFlags: Longint;
  75.     FWait: Boolean;
  76.     FNotify: Boolean;
  77.     FUseWait: Boolean;
  78.     FUseNotify: Boolean;
  79.     FUseFrom: Boolean;
  80.     FUseTo: Boolean;
  81.     FDeviceID: Word;
  82.     FDeviceType: TMPDeviceTypes;
  83.     FTo: Longint;
  84.     FFrom: Longint;
  85.     FFrames: Longint;
  86.     FError: Longint;
  87.     FNotifyValue: TMPNotifyValues;
  88.     FDisplay: TWinControl;
  89.     FDWidth: Integer;
  90.     FDHeight: Integer;
  91.     FElementName: string;
  92.     FAutoEnable: Boolean;
  93.     FAutoOpen: Boolean;
  94.     FAutoRewind: Boolean;
  95.     FShareable: Boolean;
  96.  
  97.     procedure LoadBitmaps;
  98.     procedure DestroyBitmaps;
  99.     procedure SetEnabledButtons(Value: TButtonSet);
  100.     procedure SetColored(Value: TButtonSet);
  101.     procedure SetVisible(Value: TButtonSet);
  102.     procedure SetAutoEnable(Value: Boolean);
  103.     procedure DrawAutoButtons;
  104.     procedure DoMouseDown(XPos, YPos: Integer);
  105.     procedure WMLButtonDown(var Message: TWMLButtonDown);
  106.       message WM_LButtonDown;
  107.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
  108.       message WM_LButtonDblClk;
  109.     procedure WMMouseMove(var Message: TWMMouseMove);
  110.       message WM_MouseMove;
  111.     procedure WMLButtonUp(var Message: TWMLButtonUp);
  112.       message WM_LButtonUp;
  113.     procedure WMSetFocus(var Message: TWMSetFocus);
  114.       message WM_SETFOCUS;
  115.     procedure WMKillFocus(var Message: TWMKillFocus);
  116.       message WM_KILLFOCUS;
  117.     procedure WMGetDlgCode(var Message: TWMGetDlgCode);
  118.       message WM_GETDLGCODE;
  119.     procedure WMSize(var Message: TWMSize);
  120.       message WM_SIZE;
  121.     function VisibleButtonCount: Integer;
  122.     procedure Adjust;
  123.     procedure DoClick(Button: TMPBtnType);
  124.     procedure DoPostClick(Button: TMPBtnType);
  125.     procedure DrawButton(Btn: TMPBtnType; X: Integer);
  126.     procedure CheckIfOpen;
  127.     procedure SetPosition(Value: Longint);
  128.     procedure SetDeviceType( Value: TMPDeviceTypes );
  129.     procedure SetWait( Flag: Boolean );
  130.     procedure SetNotify( Flag: Boolean );
  131.     procedure SetFrom( Value: Longint );
  132.     procedure SetTo( Value: Longint );
  133.     procedure SetTimeFormat( Value: TMPTimeFormats );
  134.     procedure SetDisplay( Value: TWinControl );
  135.     procedure SetOrigDisplay;
  136.     procedure SetDisplayRect( Value: TRect );
  137.     function GetDisplayRect: TRect;
  138.     procedure GetDeviceCaps;
  139.     function GetStart: Longint;
  140.     function GetLength: Longint;
  141.     function GetMode: TMPModes;
  142.     function GetTracks: Longint;
  143.     function GetPosition: Longint;
  144.     function GetErrorMessage: string;
  145.     function GetTimeFormat: TMPTimeFormats;
  146.     function GetTrackLength(TrackNum: Integer): Longint;
  147.     function GetTrackPosition(TrackNum: Integer): Longint;
  148.   protected
  149.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  150.     procedure Loaded; override;
  151.     procedure AutoButtonSet(Btn: TMPBtnType); dynamic;
  152.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  153.     procedure Paint; override;
  154.     procedure MMNotify(var Message: TMessage); message MM_MCINOTIFY;
  155.     procedure Click(Button: TMPBtnType; var DoDefault: Boolean); reintroduce; dynamic;
  156.     procedure PostClick(Button: TMPBtnType); dynamic;
  157.     procedure DoNotify; dynamic;
  158.     procedure Updated; override;
  159.   public
  160.     constructor Create(AOwner: TComponent); override;
  161.     destructor Destroy; override;
  162.     procedure Open;
  163.     procedure Close;
  164.     procedure Play;
  165.     procedure Stop;
  166.     procedure Pause; {Pause & Resume/Play}
  167.     procedure Step;
  168.     procedure Back;
  169.     procedure Previous;
  170.     procedure Next;
  171.     procedure StartRecording;
  172.     procedure Eject;
  173.     procedure Save;
  174.     procedure PauseOnly;
  175.     procedure Resume;
  176.     procedure Rewind;
  177.     property TrackLength[TrackNum: Integer]: Longint read GetTrackLength;
  178.     property TrackPosition[TrackNum: Integer]: Longint read GetTrackPosition;
  179.     property Capabilities: TMPDevCapsSet read FCapabilities;
  180.     property Error: Longint read FError;
  181.     property ErrorMessage: string read GetErrorMessage;
  182.     property Start: Longint read GetStart;
  183.     property Length: Longint read GetLength;
  184.     property Tracks: Longint read GetTracks;
  185.     property Frames: Longint read FFrames write FFrames;
  186.     property Mode: TMPModes read GetMode;
  187.     property Position: Longint read GetPosition write SetPosition;
  188.     property Wait: Boolean read FWait write SetWait;
  189.     property Notify: Boolean read FNotify write SetNotify;
  190.     property NotifyValue: TMPNotifyValues read FNotifyValue;
  191.     property StartPos: Longint read FFrom write SetFrom;
  192.     property EndPos: Longint read FTo write SetTo;
  193.     property DeviceID: Word read FDeviceID;
  194.     property TimeFormat: TMPTimeFormats read GetTimeFormat write SetTimeFormat;
  195.     property DisplayRect: TRect read GetDisplayRect write SetDisplayRect;
  196.   published
  197.     property ColoredButtons: TButtonSet read FColoredButtons write SetColored
  198.        default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
  199.       btRecord, btEject];
  200.     property Enabled;
  201.     property EnabledButtons: TButtonSet read FEnabledButtons write SetEnabledButtons
  202.        default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
  203.       btRecord, btEject];
  204.     property VisibleButtons: TButtonSet read FVisibleButtons write SetVisible
  205.        default [btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
  206.       btRecord, btEject];
  207.     property Anchors;
  208.     property AutoEnable: Boolean read FAutoEnable write SetAutoEnable default True;
  209.     property AutoOpen: Boolean read FAutoOpen write FAutoOpen default False;
  210.     property AutoRewind: Boolean read FAutoRewind write FAutoRewind default True;
  211.     property Constraints;
  212.     property DeviceType: TMPDeviceTypes read FDeviceType write SetDeviceType default dtAutoSelect;
  213.     property Display: TWinControl read FDisplay write SetDisplay;
  214.     property FileName: string read FElementName write FElementName;
  215.     property Shareable: Boolean read FShareable write FShareable default False;
  216.     property Visible;
  217.     property ParentShowHint;
  218.     property ShowHint;
  219.     property PopupMenu;
  220.     property TabOrder;
  221.     property TabStop default True;
  222.     property OnClick: EMPNotify read FOnClick write FOnClick;
  223.     property OnContextPopup;
  224.     property OnEnter;
  225.     property OnExit;
  226.     property OnPostClick: EMPPostNotify read FOnPostClick write FOnPostClick;
  227.     property OnNotify: TNotifyEvent read FOnNotify write FOnNotify;
  228.   end;
  229.  
  230. implementation
  231.  
  232. uses Consts;
  233.  
  234. {$R MPLAYER}
  235.  
  236. const
  237.   mci_Back     = $0899;  { mci_Step reverse }
  238.  
  239.   BtnStateName: array[TMPGlyph] of PChar = ('EN', 'DI', 'CL');
  240.   BtnTypeName: array[TMPBtnType] of PChar = ('MPPLAY', 'MPPAUSE', 'MPSTOP',
  241.     'MPNEXT', 'MPPREV', 'MPSTEP', 'MPBACK', 'MPRECORD', 'MPEJECT');
  242.  
  243. constructor TMediaPlayer.Create(AOwner: TComponent);
  244. var
  245.   I: TMPBtnType;
  246. begin
  247.   inherited Create(AOwner);
  248.   ControlStyle := ControlStyle + [csOpaque];
  249.   LoadBitmaps;
  250.   FVisibleButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
  251.     btBack, btRecord, btEject];
  252.   FEnabledButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
  253.     btBack, btRecord, btEject];
  254.   FColoredButtons := [btPlay, btPause, btStop, btNext, btPrev, btStep,
  255.     btBack, btRecord, btEject];
  256.   for I := Low(Buttons) to High(Buttons) do
  257.   begin
  258.     Buttons[I].Visible := True;
  259.     Buttons[I].Enabled := True;
  260.     Buttons[I].Colored := True;
  261.     Buttons[I].Auto := False; {enabled/disabled dynamically}
  262.   end;
  263.   Width := 240;
  264.   Height := 30;
  265.   FocusedButton := btPlay;
  266.   FAutoEnable := True;
  267.   FAutoOpen := False;
  268.   FAutoRewind := True;
  269.   FDeviceType := dtAutoSelect; {select through file name extension}
  270.   TabStop := True;
  271. end;
  272.  
  273. destructor TMediaPlayer.Destroy;
  274. var
  275.   GenParm: TMCI_Generic_Parms;
  276. begin
  277.   if FDeviceID <> 0 then
  278.     mciSendCommand( FDeviceID, mci_Close, mci_Wait, Longint(@GenParm));
  279.   DestroyBitmaps;
  280.   inherited Destroy;
  281. end;
  282.  
  283. procedure TMediaPlayer.Loaded;
  284. begin
  285.   inherited Loaded;
  286.   if (not (csDesigning in ComponentState)) and FAutoOpen then
  287.     Open;
  288. end;
  289.  
  290. procedure TMediaPlayer.LoadBitmaps;
  291. var
  292.   I: TMPBtnType;
  293.   J: TMPGlyph;
  294.   ResName: array[0..40] of Char;
  295. begin
  296.   MinBtnSize := Point(0, 0);
  297.   for I := Low(Buttons) to High(Buttons) do
  298.   begin
  299.     for J := Low(TMPGlyph) to High(TMPGlyph) do
  300.     begin
  301.       Buttons[I].Bitmaps[J] := TBitmap.Create;
  302.       Buttons[I].Bitmaps[J].Handle := LoadBitmap(HInstance,
  303.         StrFmt(ResName, '%s_%s', [BtnStateName[J], BtnTypeName[I]]));
  304.       if MinBtnSize.X < Buttons[I].Bitmaps[J].Width then
  305.         MinBtnSize.X := Buttons[I].Bitmaps[J].Width;
  306.       if MinBtnSize.Y < Buttons[I].Bitmaps[J].Height then
  307.         MinBtnSize.Y := Buttons[I].Bitmaps[J].Height;
  308.     end;
  309.   end;
  310.   Inc(MinBtnSize.X, 2 * 4);
  311.   Inc(MinBtnSize.Y, 2 * 2);
  312. end;
  313.  
  314. procedure TMediaPlayer.DestroyBitmaps;
  315. var
  316.   I: TMPBtnType;
  317.   J: TMPGlyph;
  318. begin
  319.   for I := Low(Buttons) to High(Buttons) do
  320.     for J := Low(TMPGlyph) to High(TMPGlyph) do
  321.       Buttons[I].Bitmaps[J].Free;
  322. end;
  323.  
  324.  
  325. procedure TMediaPlayer.SetAutoEnable(Value: Boolean);
  326. begin
  327.   if Value <> FAutoEnable then
  328.   begin
  329.     FAutoEnable := Value;
  330.     if FAutoEnable then
  331.       DrawAutoButtons  {paint buttons based on current state of device}
  332.     else
  333.       SetEnabledButtons(FEnabledButtons);  {paint buttons based on Enabled}
  334.   end;
  335. end;
  336.  
  337. procedure TMediaPlayer.SetEnabledButtons(Value: TButtonSet);
  338. var
  339.   I: TMPBtnType;
  340. begin
  341.   FEnabledButtons := Value;
  342.   for I := Low(Buttons) to High(Buttons) do
  343.     Buttons[I].Enabled := I in FEnabledButtons;
  344.   Invalidate;
  345. end;
  346.  
  347. procedure TMediaPlayer.DrawAutoButtons;
  348. var
  349.   I: TMPBtnType;
  350. begin
  351.   for I := Low(Buttons) to High(Buttons) do
  352.     Buttons[I].Auto := I in FAutoButtons;
  353.   Invalidate;
  354. end;
  355.  
  356. procedure TMediaPlayer.SetColored(Value: TButtonSet);
  357. var
  358.   I: TMPBtnType;
  359. begin
  360.   FColoredButtons := Value;
  361.   for I := Low(Buttons) to High(Buttons) do
  362.     Buttons[I].Colored := I in FColoredButtons;
  363.   Invalidate;
  364. end;
  365.  
  366. procedure TMediaPlayer.SetVisible(Value: TButtonSet);
  367. var
  368.   I: TMPBtnType;
  369. begin
  370.   FVisibleButtons := Value;
  371.   for I := Low(Buttons) to High(Buttons) do
  372.     Buttons[I].Visible := I in FVisibleButtons;
  373.   if csUpdating in ComponentState then
  374.   begin
  375.     ButtonWidth := ((Width - 1) div VisibleButtonCount) + 1;
  376.     Invalidate;
  377.   end
  378.   else Adjust;
  379. end;
  380.  
  381. function TMediaPlayer.VisibleButtonCount: Integer;
  382. var
  383.   I: TMPBtnType;
  384. begin
  385.   Result := 0;
  386.   for I := Low(Buttons) to High(Buttons) do
  387.     if Buttons[I].Visible then Inc(Result);
  388.   if Result = 0 then Inc(Result);
  389. end;
  390.  
  391. procedure TMediaPlayer.Adjust;
  392. var
  393.   Count: Integer;
  394. begin
  395.   Count := VisibleButtonCount;
  396.   Width := Count * (ButtonWidth - 1) + 1;
  397.   Invalidate;
  398. end;
  399.  
  400. procedure TMediaPlayer.WMSize(var Message: TWMSize);
  401. var
  402.   Count: Integer;
  403.   MinSize: TPoint;
  404.   W, H: Integer;
  405. begin
  406.   inherited;
  407.   if not (csUpdating in ComponentState) then
  408.   begin
  409.     { check for minimum size }
  410.     Count := VisibleButtonCount;
  411.     MinSize.X := Count * (MinBtnSize.X - 1) + 1;
  412.     MinSize.Y := MinBtnSize.Y;
  413.     ButtonWidth := ((Width - 1) div Count) + 1;
  414.  
  415.     W := Count * (ButtonWidth - 1) + 1;
  416.     if W < MinSize.X then W := MinSize.X;
  417.     if Height < MinSize.Y then H := MinSize.Y
  418.     else H := Height;
  419.  
  420.     if (W <> Width) or (H <> Height) then
  421.       SetBounds(Left, Top, W, H);
  422.  
  423.     Message.Result := 0;
  424.   end;
  425. end;
  426.  
  427. procedure TMediaPlayer.DrawButton(Btn: TMPBtnType; X: Integer);
  428. var
  429.   IsDown: Boolean;
  430.   BX, BY: Integer;
  431.   TheGlyph: TMPGlyph;
  432.   Bitmap: TBitmap;
  433.   R: TRect;
  434. begin
  435.   IsDown := Down and (Btn = CurrentButton);
  436.   with Canvas do
  437.   begin
  438.     Brush.Style := bsSolid;
  439.     Brush.Color := clBtnFace;
  440.     Pen.Color := clWindowFrame;
  441.     Pen.Width := 1;
  442.     Rectangle(X, 0, X + ButtonWidth, Height);
  443.  
  444.     { draw button beveling }
  445.     if IsDown then
  446.     begin
  447.       Pen.Color := clBtnShadow;
  448.       MoveTo(X + 1, Height - 2);
  449.       LineTo(X + 1, 1);
  450.       LineTo(X + ButtonWidth - 1, 1);
  451.     end
  452.     else
  453.     begin
  454.       Pen.Color := clBtnHighlight;
  455.       MoveTo(X + 1, Height - 2);
  456.       LineTo(X + 1, 1);
  457.       LineTo(X + ButtonWidth - 1, 1);
  458.       Pen.Color := clBtnShadow;
  459.       MoveTo(X + 2, Height - 2);
  460.       LineTo(X + ButtonWidth - 2, Height - 2);
  461.       LineTo(X + ButtonWidth - 2, 1);
  462.     end;
  463.  
  464.     {which bitmap logic - based on Enabled, Colored, and AutoEnable}
  465.     if Enabled or (csDesigning in ComponentState) then
  466.     begin  {Enabled only affects buttons at runtime}
  467.       if FAutoEnable and not (csDesigning in ComponentState) then
  468.       begin  {AutoEnable only affects buttons at runtime}
  469.         if Buttons[Btn].Auto then {is button available, based on device state}
  470.         begin
  471.           TheGlyph := mgEnabled;
  472.           if Buttons[Btn].Colored then
  473.             TheGlyph := mgColored;
  474.         end
  475.         else TheGlyph := mgDisabled;  {button is not available}
  476.       end
  477.       else  {when not AutoEnabled or at design-time, check Enabled}
  478.       begin
  479.         if Buttons[Btn].Enabled then
  480.         begin
  481.           TheGlyph := mgEnabled;
  482.           if Buttons[Btn].Colored then
  483.             TheGlyph := mgColored;
  484.         end
  485.         else TheGlyph := mgDisabled;
  486.       end;
  487.     end
  488.     else TheGlyph := mgDisabled; {main switch set to disabled}
  489.  
  490.     Bitmap := Buttons[Btn].Bitmaps[TheGlyph];
  491.     BX := (ButtonWidth div 2) - (Bitmap.Width div 2);
  492.     BY := (Height div 2) - (Bitmap.Height div 2);
  493.     if IsDown then
  494.     begin
  495.       Inc(BX);
  496.       Inc(BY);
  497.     end;
  498.     BrushCopy(Bounds(X + BX, BY, Bitmap.Width, Bitmap.Height),
  499.       Bitmap, Rect(0, 0, Bitmap.Width, Bitmap.Height), clOlive);
  500.   end;
  501.  
  502.   if (GetFocus = Handle) and (Btn = FocusedButton) then
  503.   begin
  504.     R := Bounds(X, 0, ButtonWidth, Height);
  505.     InflateRect(R, -3, -3);
  506.     if IsDown then OffsetRect(R, 1, 1);
  507.     DrawFocusRect(Canvas.Handle, R);
  508.   end;
  509. end;
  510.  
  511. procedure TMediaPlayer.Paint;
  512. var
  513.   X: Integer;
  514.   I: TMPBtnType;
  515. begin
  516.   with Canvas do
  517.   begin
  518.     Brush.Style := bsClear;
  519.     Pen.Color := clWindowFrame;
  520.     Pen.Width := 1;
  521.     Rectangle(0, 0, Width, Height);
  522.  
  523.     X := 0;
  524.     for I := Low(Buttons) to High(Buttons) do
  525.     begin
  526.       if Buttons[I].Visible then
  527.       begin
  528.         DrawButton(I, X);
  529.         Inc(X, ButtonWidth - 1);
  530.       end;
  531.     end;
  532.   end;
  533. end;
  534.  
  535. {AutoEnable=True, enable/disable button set based on button passed (pressed)}
  536. procedure TMediaPlayer.AutoButtonSet(Btn: TMPBtnType);
  537. begin
  538.   case Btn of
  539.     btPlay:
  540.     begin
  541.       FAutoButtons := FAutoButtons - [btPlay,btRecord];
  542.       FAutoButtons := FAutoButtons + [btStop,btPause];
  543.     end;
  544.     btPause:
  545.     begin
  546.       if FCanPlay then Include(FAutoButtons,btPlay);
  547.       if FCanRecord then Include(FAutoButtons,btRecord);
  548.     end;
  549.     btStop:
  550.     begin
  551.       if FCanPlay then Include(FAutoButtons,btPlay);
  552.       if FCanRecord then Include(FAutoButtons,btRecord);
  553.       FAutoButtons := FAutoButtons - [btStop,btPause];
  554.     end;
  555.     btNext:
  556.     begin
  557.       if FCanPlay then Include(FAutoButtons,btPlay);
  558.       if FCanRecord then Include(FAutoButtons,btRecord);
  559.       FAutoButtons := FAutoButtons - [btStop,btPause];
  560.     end;
  561.     btPrev:
  562.     begin
  563.       if FCanPlay then Include(FAutoButtons,btPlay);
  564.       if FCanRecord then Include(FAutoButtons,btRecord);
  565.       FAutoButtons := FAutoButtons - [btStop,btPause];
  566.     end;
  567.     btStep:
  568.     begin
  569.       if FCanPlay then Include(FAutoButtons,btPlay);
  570.       if FCanRecord then Include(FAutoButtons,btRecord);
  571.       FAutoButtons := FAutoButtons - [btStop,btPause];
  572.     end;
  573.     btBack:
  574.     begin
  575.       if FCanPlay then Include(FAutoButtons,btPlay);
  576.       if FCanRecord then Include(FAutoButtons,btRecord);
  577.       FAutoButtons := FAutoButtons - [btStop,btPause];
  578.     end;
  579.     btRecord:
  580.     begin
  581.       FAutoButtons := FAutoButtons - [btPlay,btRecord];
  582.       FAutoButtons := FAutoButtons + [btStop,btPause];
  583.     end;
  584.     btEject: {without polling no way to determine when CD is inserted}
  585.     begin
  586.       if FCanPlay then Include(FAutoButtons,btPlay);
  587.       if FCanRecord then Include(FAutoButtons,btRecord);
  588.       FAutoButtons := FAutoButtons - [btStop,btPause];
  589.     end;
  590.   end;
  591. end;
  592.       
  593. procedure TMediaPlayer.DoMouseDown(XPos, YPos: Integer);
  594. var
  595.   I: TMPBtnType;
  596.   X: Integer;
  597. begin
  598.   {which button was clicked}
  599.   X := 0;
  600.   for I := Low(Buttons) to High(Buttons) do
  601.   begin
  602.     if Buttons[I].Visible then
  603.     begin
  604.       if (XPos >= X) and (XPos <= X + ButtonWidth) then
  605.       begin
  606.         if FAutoEnable then
  607.           if Buttons[I].Auto then Break
  608.           else Exit;
  609.         if Buttons[I].Enabled then Break
  610.         else Exit;
  611.       end;
  612.       Inc(X, ButtonWidth - 1);
  613.     end;
  614.   end;
  615.   CurrentButton := I;
  616.   if CurrentButton <> FocusedButton then
  617.   begin
  618.     FocusedButton := CurrentButton;
  619.     Paint;
  620.   end;
  621.   CurrentRect := Rect(X, 0, X + ButtonWidth, Height);
  622.   Pressed := True;
  623.   Down := True;
  624.   DrawButton(I, X);
  625.   MouseCapture := True;
  626. end;
  627.  
  628. procedure TMediaPlayer.WMLButtonDown(var Message: TWMLButtonDown);
  629. begin
  630.   DoMouseDown(Message.XPos, Message.YPos);
  631. end;
  632.  
  633. procedure TMediaPlayer.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  634. begin
  635.   DoMouseDown(Message.XPos, Message.YPos);
  636. end;
  637.  
  638. procedure TMediaPlayer.WMMouseMove(var Message: TWMMouseMove);
  639. var
  640.   P: TPoint;
  641. begin
  642.   if Pressed then
  643.   begin
  644.     P := Point(Message.XPos, Message.YPos);
  645.     if PtInRect(CurrentRect, P) <> Down then
  646.     begin
  647.       Down := not Down;
  648.       DrawButton(CurrentButton, CurrentRect.Left);
  649.     end;
  650.   end;
  651. end;
  652.  
  653. procedure TMediaPlayer.DoClick(Button: TMPBtnType);
  654. var
  655.   DoDefault: Boolean;
  656. begin
  657.   DoDefault := True;
  658.   Click(CurrentButton, DoDefault);
  659.   if DoDefault then
  660.   begin
  661.     case CurrentButton of
  662.       btPlay: Play;
  663.       btPause: Pause;
  664.       btStop: Stop;
  665.       btNext: Next;
  666.       btPrev: Previous;
  667.       btStep: Step;
  668.       btBack: Back;
  669.       btRecord: StartRecording;
  670.       btEject: Eject;
  671.     end;
  672.     DoPostClick(CurrentButton);
  673.   end;
  674. end;
  675.  
  676. procedure TMediaPlayer.DoPostClick(Button: TMPBtnType);
  677. begin
  678.   PostClick(CurrentButton);
  679. end;
  680.  
  681. procedure TMediaPlayer.WMLButtonUp(var Message: TWMLButtonUp);
  682. begin
  683.   MouseCapture := False;
  684.   if Pressed and Down then
  685.   begin
  686.     Down := False;
  687.     DrawButton(CurrentButton, CurrentRect.Left);  {raise button before calling code}
  688.     DoClick(CurrentButton);
  689.     if FAutoEnable and (FError = 0) and MCIOpened then
  690.     begin
  691.       AutoButtonSet(CurrentButton);
  692.       DrawAutoButtons;
  693.     end;
  694.   end;
  695.   Pressed := False;
  696. end;
  697.  
  698. procedure TMediaPlayer.WMSetFocus(var Message: TWMSetFocus);
  699. begin
  700.   Paint;
  701. end;
  702.  
  703. procedure TMediaPlayer.WMKillFocus(var Message: TWMKillFocus);
  704. begin
  705.   Paint;
  706. end;
  707.  
  708. procedure TMediaPlayer.WMGetDlgCode(var Message: TWMGetDlgCode);
  709. begin
  710.   Message.Result := DLGC_WANTARROWS;
  711. end;
  712.  
  713. procedure TMediaPlayer.KeyDown(var Key: Word; Shift: TShiftState);
  714. var
  715.   NewFocus: TMPBtnType;
  716. begin
  717.   case Key of
  718.     VK_RIGHT:
  719.       begin
  720.         NewFocus := FocusedButton;
  721.         repeat
  722.           if NewFocus < High(Buttons) then
  723.             NewFocus := Succ(NewFocus);
  724.         until (NewFocus = High(Buttons)) or (Buttons[NewFocus].Visible);
  725.         if NewFocus <> FocusedButton then
  726.         begin
  727.           FocusedButton := NewFocus;
  728.           Invalidate;
  729.         end;
  730.       end;
  731.     VK_LEFT:
  732.       begin
  733.         NewFocus := FocusedButton;
  734.         repeat
  735.           if NewFocus > Low(Buttons) then
  736.             NewFocus := Pred(NewFocus);
  737.         until (NewFocus = Low(Buttons)) or (Buttons[NewFocus].Visible);
  738.         if NewFocus <> FocusedButton then
  739.         begin
  740.           FocusedButton := NewFocus;
  741.           Invalidate;
  742.         end;
  743.       end;
  744.     VK_SPACE:
  745.       begin
  746.         if Buttons[FocusedButton].Enabled then
  747.         begin
  748.           CurrentButton := FocusedButton;
  749.           DoClick(CurrentButton);
  750.           if FAutoEnable then
  751.           begin
  752.             AutoButtonSet(CurrentButton);
  753.             DrawAutoButtons;
  754.           end;
  755.         end;
  756.       end;
  757.   end;
  758. end;
  759.  
  760. {MCI message generated when Notify=True, and MCI command completes}
  761. procedure TMediaPlayer.MMNotify(var Message: TMessage);
  762. begin
  763.   if FAutoEnable and (Mode = mpStopped) then
  764.   begin {special AutoEnable case for when Play and Record finish}
  765.     if FCanPlay then Include(FAutoButtons,btPlay);
  766.     if FCanRecord then Include(FAutoButtons,btRecord);
  767.     FAutoButtons := FAutoButtons - [btStop,btPause];
  768.     DrawAutoButtons;
  769.   end;
  770.   case Message.WParam of
  771.     mci_Notify_Successful: FNotifyValue := nvSuccessful;
  772.     mci_Notify_Superseded: FNotifyValue := nvSuperseded;
  773.     mci_Notify_Aborted: FNotifyValue := nvAborted;
  774.     mci_Notify_Failure: FNotifyValue := nvFailure;
  775.   end;
  776.   DoNotify;
  777. end;
  778.  
  779. {for MCI Commands to make sure device is open, else raise exception}
  780. procedure TMediaPlayer.CheckIfOpen;
  781. begin
  782.   if not MCIOpened then raise EMCIDeviceError.CreateRes(@sNotOpenErr);
  783. end;
  784.  
  785. procedure TMediaPlayer.Click(Button: TMPBtnType; var DoDefault: Boolean);
  786. begin
  787.   if Assigned(FOnCLick) then FOnClick(Self, Button, DoDefault);
  788. end;
  789.  
  790. procedure TMediaPlayer.PostClick(Button: TMPBtnType);
  791. begin
  792.   if Assigned(FOnPostCLick) then FOnPostClick(Self, Button);
  793. end;
  794.  
  795. procedure TMediaPlayer.DoNotify;
  796. begin
  797.   if Assigned(FOnNotify) then FOnNotify(Self);
  798. end;
  799.  
  800. procedure TMediaPlayer.Updated;
  801. begin
  802.   inherited;
  803.   Adjust;
  804. end;
  805.  
  806. {***** MCI Commands *****}
  807.  
  808. procedure TMediaPlayer.Open;
  809. const
  810.   DeviceName: array[TMPDeviceTypes] of PChar = ('', 'AVIVideo', 'CDAudio', 'DAT',
  811.     'DigitalVideo', 'MMMovie', 'Other', 'Overlay', 'Scanner', 'Sequencer',
  812.     'VCR', 'Videodisc', 'WaveAudio');
  813. var
  814.   OpenParm: TMCI_Open_Parms;
  815.   DisplayR: TRect;
  816. begin
  817.   { zero out memory }
  818.   FillChar(OpenParm, SizeOf(TMCI_Open_Parms), 0);
  819.   if MCIOpened then Close; {must close MCI Device first before opening another}
  820.  
  821.   OpenParm.dwCallback := 0;
  822.   OpenParm.lpstrDeviceType := DeviceName[FDeviceType];
  823.   OpenParm.lpstrElementName := PChar(FElementName);
  824.  
  825.   FFlags := 0;
  826.  
  827.   if FUseWait then
  828.   begin
  829.     if FWait then FFlags := mci_Wait;
  830.     FUseWait := False;
  831.   end
  832.   else 
  833.     FFlags := mci_Wait;
  834.  
  835.   if FUseNotify then
  836.   begin
  837.     if FNotify then FFlags := FFlags or mci_Notify;
  838.     FUseNotify := False;
  839.   end;
  840.  
  841.   if FDeviceType <> dtAutoSelect then 
  842.     FFlags := FFlags or mci_Open_Type
  843.   else
  844.     FFlags := FFlags or MCI_OPEN_ELEMENT;
  845.  
  846.   if FShareable then 
  847.     FFlags := FFlags or mci_Open_Shareable;
  848.   OpenParm.dwCallback := Handle;
  849.  
  850.   FError := mciSendCommand(0, mci_Open, FFlags, Longint(@OpenParm));
  851.  
  852.   if FError <> 0 then {problem opening device}
  853.     raise EMCIDeviceError.Create(ErrorMessage)
  854.   else {device successfully opened}
  855.   begin
  856.     MCIOpened := True;
  857.     FDeviceID := OpenParm.wDeviceID;
  858.     FFrames := Length div 10;  {default frames to step = 10% of total frames}
  859.     GetDeviceCaps; {must first get device capabilities}
  860.     if FHasVideo then {used for video output positioning}
  861.     begin
  862.       Display := FDisplay; {if one was set in design mode}
  863.       DisplayR := GetDisplayRect;
  864.       FDWidth := DisplayR.Right-DisplayR.Left;
  865.       FDHeight := DisplayR.Bottom-DisplayR.Top;
  866.     end;
  867.     if (FDeviceType = dtCDAudio) or (FDeviceType = dtVideodisc) then
  868.       TimeFormat := tfTMSF; {set timeformat to use tracks}
  869.     
  870.     FAutoButtons := [btNext,btPrev]; {assumed all devices can seek to start, end}
  871.     if FCanStep then FAutoButtons := FAutoButtons + [btStep,btBack];
  872.     if FCanPlay then Include(FAutoButtons, btPlay);
  873.     if FCanRecord then Include(FAutoButtons, btRecord);
  874.     if FCanEject then Include(FAutoButtons, btEject);
  875.     if Mode = mpPlaying then AutoButtonSet(btPlay); {e.g. CD device}
  876.     DrawAutoButtons;
  877.   end;
  878.     
  879. end;
  880.  
  881. procedure TMediaPlayer.Close;
  882. var
  883.   GenParm: TMCI_Generic_Parms;
  884. begin
  885.   if FDeviceID <> 0 then
  886.   begin
  887.     FFlags := 0;
  888.     if FUseWait then
  889.     begin
  890.       if FWait then FFlags := mci_Wait;
  891.       FUseWait := False;
  892.     end
  893.     else FFlags := mci_Wait;
  894.     if FUseNotify then
  895.     begin
  896.       if FNotify then FFlags := FFlags or mci_Notify;
  897.       FUseNotify := False;
  898.     end;
  899.     GenParm.dwCallback := Handle;
  900.     FError := mciSendCommand( FDeviceID, mci_Close, FFlags, Longint(@GenParm));
  901.     if FError = 0 then
  902.     begin
  903.       MCIOpened := False;
  904.       FDeviceID := 0;
  905.       FAutoButtons := [];
  906.       DrawAutoButtons;
  907.     end;
  908.   end; {if DeviceID <> 0}
  909. end;
  910.  
  911. procedure TMediaPlayer.Play;
  912. var
  913.   PlayParm: TMCI_Play_Parms;
  914. begin
  915.   CheckIfOpen; {raises exception if device is not open}
  916.  
  917.   {if at the end of media, and not using StartPos or EndPos - go to start}
  918.   if FAutoRewind and (Position = Length) then
  919.     if not FUseFrom and not FUseTo then Rewind;
  920.  
  921.   FFlags := 0;
  922.   if FUseNotify then
  923.   begin
  924.     if FNotify then FFlags := mci_Notify;
  925.     FUseNotify := False;
  926.   end else FFlags := mci_Notify;
  927.   if FUseWait then
  928.   begin
  929.     if FWait then FFlags := FFlags or mci_Wait;
  930.     FUseWait := False;
  931.   end;
  932.   if FUseFrom then
  933.   begin
  934.     FFlags := FFlags or mci_From;
  935.     PlayParm.dwFrom := FFrom;
  936.     FUseFrom := False; {only applies to this mciSendCommand}
  937.   end;
  938.   if FUseTo then
  939.   begin
  940.     FFlags := FFlags or mci_To;
  941.     PlayParm.dwTo := FTo;
  942.     FUseTo := False; {only applies to this mciSendCommand}
  943.   end;
  944.   PlayParm.dwCallback := Handle;
  945.   FError := mciSendCommand( FDeviceID, mci_Play, FFlags, Longint(@PlayParm));
  946. end;
  947.  
  948. procedure TMediaPlayer.StartRecording;
  949. var
  950.   RecordParm: TMCI_Record_Parms;
  951. begin
  952.   CheckIfOpen; {raises exception if device is not open}
  953.  
  954.   FFlags := 0;
  955.   if FUseNotify then
  956.   begin
  957.     if FNotify then FFlags := mci_Notify;
  958.     FUseNotify := False;
  959.   end
  960.   else FFlags := mci_Notify;
  961.   if FUseWait then
  962.   begin
  963.     if FWait then FFlags := FFlags or mci_Wait;
  964.     FUseWait := False;
  965.   end;
  966.  
  967.   if FUseFrom then
  968.   begin
  969.     FFlags := FFlags or mci_From;
  970.     RecordParm.dwFrom := FFrom;
  971.     FUseFrom := False;
  972.   end;
  973.   if FUseTo then
  974.   begin
  975.     FFlags := FFlags or mci_To;
  976.     RecordParm.dwTo := FTo;
  977.     FUseTo := False;
  978.   end;
  979.   RecordParm.dwCallback := Handle;
  980.   FError := mciSendCommand( FDeviceID, mci_Record, FFlags, Longint(@RecordParm));
  981. end;
  982.  
  983. procedure TMediaPlayer.Stop;
  984. var
  985.   GenParm: TMCI_Generic_Parms;
  986. begin
  987.   CheckIfOpen; {raises exception if device is not open}
  988.  
  989.   FFlags := 0;
  990.   if FUseWait then
  991.   begin
  992.     if FWait then FFlags := mci_Wait;
  993.     FUseWait := False;
  994.   end
  995.   else FFlags := mci_Wait;
  996.   if FUseNotify then
  997.   begin
  998.     if FNotify then FFlags := FFlags or mci_Notify;
  999.     FUseNotify := False;
  1000.   end;
  1001.   GenParm.dwCallback := Handle;
  1002.   FError := mciSendCommand( FDeviceID, mci_Stop, FFlags, Longint(@GenParm));
  1003. end;
  1004.  
  1005. procedure TMediaPlayer.Pause;
  1006. begin
  1007.   if not MCIOpened then Raise EMCIDeviceError.CreateRes(@sNotOpenErr);
  1008.   if Mode = mpPlaying then PauseOnly
  1009.   else
  1010.    if Mode = mpPaused then Resume;
  1011. end;
  1012.  
  1013. procedure TMediaPlayer.PauseOnly;
  1014. var
  1015.   GenParm: TMCI_Generic_Parms;
  1016. begin
  1017.   CheckIfOpen; {raises exception if device is not open}
  1018.  
  1019.   FFlags := 0;
  1020.   if FUseWait then
  1021.   begin
  1022.     if FWait then FFlags := mci_Wait;
  1023.     FUseWait := False;
  1024.   end
  1025.   else FFlags := mci_Wait;
  1026.   if FUseNotify then
  1027.   begin
  1028.     if FNotify then FFlags := FFlags or mci_Notify;
  1029.     FUseNotify := False;
  1030.   end;
  1031.   GenParm.dwCallback := Handle;
  1032.   FError := mciSendCommand( FDeviceID, mci_Pause, FFlags, Longint(@GenParm));
  1033. end;
  1034.  
  1035. procedure TMediaPlayer.Resume;
  1036. var
  1037.   GenParm: TMCI_Generic_Parms;
  1038. begin
  1039.   CheckIfOpen; {raises exception if device is not open}
  1040.  
  1041.   FFlags := 0;
  1042.   if FUseNotify then
  1043.   begin
  1044.     if FNotify then FFlags := mci_Notify;
  1045.   end
  1046.   else FFlags := mci_Notify;
  1047.   if FUseWait then
  1048.   begin
  1049.     if FWait then FFlags := FFlags or mci_Wait;
  1050.   end;
  1051.   GenParm.dwCallback := Handle;
  1052.   FError := mciSendCommand( FDeviceID, mci_Resume, FFlags, Longint(@GenParm));
  1053.   
  1054.   {if error calling resume (resume not supported),  call Play}
  1055.   if FError <> 0 then
  1056.     Play {FUseNotify & FUseWait reset by Play}
  1057.   else
  1058.   begin
  1059.     if FUseNotify then
  1060.       FUseNotify := False;
  1061.     if FUseWait then
  1062.       FUseWait := False;
  1063.   end;
  1064. end;
  1065.  
  1066. procedure TMediaPlayer.Next;
  1067. var
  1068.   SeekParm: TMCI_Seek_Parms;
  1069.   TempFlags: Longint;
  1070. begin
  1071.   CheckIfOpen; {raises exception if device is not open}
  1072.  
  1073.   FFlags := 0;
  1074.   if FUseWait then
  1075.   begin
  1076.     if FWait then FFlags := mci_Wait;
  1077.     FUseWait := False;
  1078.   end
  1079.   else FFlags := mci_Wait;
  1080.   if FUseNotify then
  1081.   begin
  1082.     if FNotify then FFlags := FFlags or mci_Notify;
  1083.     FUseNotify := False;
  1084.   end;
  1085.  
  1086.   TempFlags := FFlags; {preserve FFlags from GetTimeFormat & GetPosition}
  1087.   if TimeFormat = tfTMSF then {using Tracks}
  1088.   begin
  1089.     if Mode = mpPlaying then 
  1090.     begin
  1091.       if mci_TMSF_Track(Position) = Tracks then {if at last track}
  1092.          StartPos := GetTrackPosition(Tracks) {go to beg of last}
  1093.       else {go to next track}
  1094.          StartPos := GetTrackPosition((mci_TMSF_Track(Position))+1);
  1095.       Play;
  1096.       CurrentButton := btPlay;
  1097.       Exit;
  1098.     end
  1099.     else
  1100.     begin
  1101.       if mci_TMSF_Track(Position) = Tracks then {if at last track}
  1102.          SeekParm.dwTo := GetTrackPosition(Tracks) {go to beg of last}
  1103.       else {go to next track}
  1104.          SeekParm.dwTo := GetTrackPosition((mci_TMSF_Track(Position))+1);
  1105.       FFlags := TempFlags or mci_To;
  1106.     end;
  1107.   end
  1108.   else
  1109.     FFlags := TempFlags or mci_Seek_To_End;
  1110.     
  1111.   SeekParm.dwCallback := Handle;
  1112.   FError := mciSendCommand( FDeviceID, mci_Seek, FFlags, Longint(@SeekParm));
  1113. end; {Next}
  1114.  
  1115.  
  1116. procedure TMediaPlayer.Previous;
  1117. var
  1118.   SeekParm: TMCI_Seek_Parms;
  1119.   tpos,cpos,TempFlags: Longint;
  1120. begin
  1121.   CheckIfOpen; {raises exception if device is not open}
  1122.  
  1123.   FFlags := 0;
  1124.   if FUseWait then
  1125.   begin
  1126.     if FWait then FFlags := mci_Wait;
  1127.     FUseWait := False;
  1128.   end
  1129.   else FFlags := mci_Wait;
  1130.   if FUseNotify then
  1131.   begin
  1132.     if FNotify then FFlags := FFlags or mci_Notify;
  1133.     FUseNotify := False;
  1134.   end;
  1135.   
  1136.   TempFlags := FFlags; {preserve FFlags from GetTimeFormat & GetPosition}
  1137.   if TimeFormat = tfTMSF then {using Tracks}
  1138.   begin
  1139.     cpos := Position;
  1140.     tpos := GetTrackPosition(mci_TMSF_Track(Position));
  1141.     if Mode = mpPlaying then 
  1142.     begin
  1143.         {if not on first track, and at beginning of current track}
  1144.         if (mci_TMSF_Track(cpos) <> 1) and
  1145.           (mci_TMSF_Minute(cpos) = mci_TMSF_Minute(tpos)) and
  1146.           (mci_TMSF_Second(cpos) = mci_TMSF_Second(tpos)) then
  1147.           StartPos := GetTrackPosition(mci_TMSF_Track(Position)-1) {go to previous}
  1148.         else
  1149.           StartPos := tpos; {otherwise, go to beginning of current}
  1150.       Play;
  1151.       CurrentButton := btPlay;
  1152.       Exit;
  1153.      end
  1154.      else
  1155.      begin
  1156.         {if not on first track, and at beginning of current track}
  1157.         if (mci_TMSF_Track(cpos) <> 1) and
  1158.           (mci_TMSF_Minute(cpos) = mci_TMSF_Minute(tpos)) and
  1159.           (mci_TMSF_Second(cpos) = mci_TMSF_Second(tpos)) then
  1160.           SeekParm.dwTo := GetTrackPosition(mci_TMSF_Track(Position)-1) {go to previous}
  1161.         else
  1162.           SeekParm.dwTo := tpos; {otherwise, go to beginning of current}
  1163.         FFlags := TempFlags or mci_To;
  1164.      end;
  1165.   end
  1166.   else
  1167.     FFlags := TempFlags or mci_Seek_To_Start;
  1168.     
  1169.   SeekParm.dwCallback := Handle;
  1170.   FError := mciSendCommand( FDeviceID, mci_Seek, FFlags, Longint(@SeekParm));
  1171. end; {Previous}
  1172.  
  1173. procedure TMediaPlayer.Step;
  1174. var
  1175.   AStepParm: TMCI_Anim_Step_Parms;
  1176. begin
  1177.   CheckIfOpen; {raises exception if device is not open}
  1178.  
  1179.   if FHasVideo then
  1180.   begin
  1181.     if FAutoRewind and (Position = Length) then Rewind;
  1182.  
  1183.     FFlags := 0;
  1184.     if FUseWait then
  1185.     begin
  1186.       if FWait then FFlags := mci_Wait;
  1187.       FUseWait := False;
  1188.     end
  1189.     else FFlags := mci_Wait;
  1190.     if FUseNotify then
  1191.     begin
  1192.       if FNotify then FFlags := FFlags or mci_Notify;
  1193.       FUseNotify := False;
  1194.     end;
  1195.     FFlags := FFlags or mci_Anim_Step_Frames;
  1196.     AStepParm.dwFrames := FFrames;
  1197.     AStepParm.dwCallback := Handle;
  1198.     FError := mciSendCommand( FDeviceID, mci_Step, FFlags, Longint(@AStepParm) );
  1199.   end; {if HasVideo}
  1200. end;
  1201.  
  1202. procedure TMediaPlayer.Back;
  1203. var
  1204.   AStepParm: TMCI_Anim_Step_Parms;
  1205. begin
  1206.   CheckIfOpen; {raises exception if device is not open}
  1207.  
  1208.   if FHasVideo then
  1209.   begin
  1210.     FFlags := 0;
  1211.     if FUseWait then
  1212.     begin
  1213.       if FWait then FFlags := mci_Wait;
  1214.       FUseWait := False;
  1215.     end
  1216.     else FFlags := mci_Wait;
  1217.     if FUseNotify then
  1218.     begin
  1219.       if FNotify then FFlags := FFlags or mci_Notify;
  1220.       FUseNotify := False;
  1221.     end;
  1222.     FFlags := FFlags or mci_Anim_Step_Frames or mci_Anim_Step_Reverse;
  1223.     AStepParm.dwFrames := FFrames;
  1224.     AStepParm.dwCallback := Handle;
  1225.     FError := mciSendCommand( FDeviceID, mci_Step, FFlags, Longint(@AStepParm) );
  1226.   end; {if HasVideo}
  1227. end; {Back}
  1228.  
  1229. procedure TMediaPlayer.Eject;
  1230. var
  1231.   SetParm: TMCI_Set_Parms;
  1232. begin
  1233.   CheckIfOpen; {raises exception if device is not open}
  1234.  
  1235.   if FCanEject then
  1236.   begin
  1237.     FFlags := 0;
  1238.     if FUseWait then
  1239.     begin
  1240.       if FWait then FFlags := mci_Wait;
  1241.       FUseWait := False;
  1242.     end
  1243.     else FFlags := mci_Wait;
  1244.     if FUseNotify then
  1245.     begin
  1246.       if FNotify then FFlags := FFlags or mci_Notify;
  1247.       FUseNotify := False;
  1248.     end;
  1249.     FFlags := FFlags or mci_Set_Door_Open;
  1250.     SetParm.dwCallback := Handle;
  1251.     FError := mciSendCommand( FDeviceID, mci_Set, FFlags, Longint(@SetParm) );
  1252.   end; {if CanEject}
  1253. end; {Eject}
  1254.  
  1255. procedure TMediaPlayer.SetPosition(Value: Longint);
  1256. var
  1257.   SeekParm: TMCI_Seek_Parms;
  1258. begin
  1259.   CheckIfOpen; {raises exception if device is not open}
  1260.  
  1261.   FFlags := 0;
  1262.   if FUseWait then
  1263.   begin
  1264.     if FWait then FFlags := mci_Wait;
  1265.     FUseWait := False;
  1266.   end
  1267.   else FFlags := mci_Wait;
  1268.   if FUseNotify then
  1269.   begin
  1270.     if FNotify then FFlags := FFlags or mci_Notify;
  1271.     FUseNotify := False;
  1272.   end;
  1273.   FFlags := FFlags or mci_To;
  1274.   SeekParm.dwCallback := Handle;
  1275.   SeekParm.dwTo := Value;
  1276.   FError := mciSendCommand( FDeviceID, mci_Seek, FFlags, Longint(@SeekParm));
  1277. end;
  1278.  
  1279. procedure TMediaPlayer.Rewind;
  1280. var
  1281.   SeekParm: TMCI_Seek_Parms;
  1282.   RFlags: Longint;
  1283. begin
  1284.   CheckIfOpen; {raises exception if device is not open}
  1285.   RFlags := mci_Wait or mci_Seek_To_Start;
  1286.   mciSendCommand( FDeviceID, mci_Seek, RFlags, Longint(@SeekParm));
  1287. end;
  1288.  
  1289. function TMediaPlayer.GetTrackLength(TrackNum: Integer): Longint;
  1290. var
  1291.   StatusParm: TMCI_Status_Parms;
  1292. begin
  1293.   CheckIfOpen; {raises exception if device is not open}
  1294.   FFlags := mci_Wait or mci_Status_Item or mci_Track;
  1295.   StatusParm.dwItem := mci_Status_Length;
  1296.   StatusParm.dwTrack := Longint(TrackNum);
  1297.   mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  1298.   Result := StatusParm.dwReturn;
  1299. end;
  1300.  
  1301. function TMediaPlayer.GetTrackPosition(TrackNum: Integer): Longint;
  1302. var
  1303.   StatusParm: TMCI_Status_Parms;
  1304. begin
  1305.   FFlags := mci_Wait or mci_Status_Item or mci_Track;
  1306.   StatusParm.dwItem := mci_Status_Position;
  1307.   StatusParm.dwTrack := Longint(TrackNum);
  1308.   mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  1309.   Result := StatusParm.dwReturn;
  1310. end;
  1311.  
  1312. procedure TMediaPlayer.Save;
  1313. var
  1314.   SaveParm: TMCI_SaveParms;
  1315. begin
  1316.   CheckIfOpen; {raises exception if device is not open}
  1317.   if FElementName <> '' then {make sure a file has been specified to save to}
  1318.   begin
  1319.     SaveParm.lpfilename := PChar(FElementName);
  1320.  
  1321.     FFlags := 0;
  1322.     if FUseWait then
  1323.     begin
  1324.       if FWait then FFlags := mci_Wait;
  1325.       FUseWait := False;
  1326.     end
  1327.     else FFlags := mci_Wait;
  1328.     if FUseNotify then
  1329.     begin
  1330.       if FNotify then FFlags := FFlags or mci_Notify;
  1331.       FUseNotify := False;
  1332.     end;
  1333.     SaveParm.dwCallback := Handle;
  1334.     FFlags := FFlags or mci_Save_File;
  1335.     FError := mciSendCommand(FDeviceID, mci_Save, FFlags, Longint(@SaveParm));
  1336.     end;
  1337. end;
  1338.  
  1339.  
  1340. {*** procedures that set control flags for MCI Commands ***}
  1341. procedure TMediaPlayer.SetWait( Flag: Boolean );
  1342. begin
  1343.   if Flag <> FWait then FWait := Flag;
  1344.   FUseWait := True;
  1345. end;
  1346.  
  1347. procedure TMediaPlayer.SetNotify( Flag: Boolean );
  1348. begin
  1349.   if Flag <> FNotify then FNotify := Flag;
  1350.   FUseNotify := True;
  1351. end;
  1352.  
  1353. procedure TMediaPlayer.SetFrom( Value: Longint );
  1354. begin
  1355.   if Value <> FFrom then FFrom := Value;
  1356.   FUseFrom := True;
  1357. end;
  1358.  
  1359. procedure TMediaPlayer.SetTo( Value: Longint );
  1360. begin
  1361.   if Value <> FTo then FTo := Value;
  1362.   FUseTo := True;
  1363. end;
  1364.  
  1365.  
  1366. procedure TMediaPlayer.SetDeviceType( Value: TMPDeviceTypes );
  1367. begin
  1368.   if Value <> FDeviceType then FDeviceType := Value;
  1369. end;
  1370.  
  1371. procedure TMediaPlayer.SetTimeFormat( Value: TMPTimeFormats );
  1372. var
  1373.   SetParm: TMCI_Set_Parms;
  1374. begin
  1375.   begin
  1376.     FFlags := mci_Notify or mci_Set_Time_Format;
  1377.     SetParm.dwTimeFormat := Longint(Value);
  1378.     FError := mciSendCommand( FDeviceID, mci_Set, FFlags, Longint(@SetParm) );
  1379.   end;
  1380. end;
  1381.  
  1382. {setting a TWinControl to display video devices' output}
  1383. procedure TMediaPlayer.SetDisplay( Value: TWinControl );
  1384. var
  1385.   AWindowParm: TMCI_Anim_Window_Parms;
  1386. begin
  1387.   if (Value <> nil) and MCIOpened and FHasVideo then
  1388.   begin
  1389.     FFlags := mci_Wait or mci_Anim_Window_hWnd;
  1390.     AWindowParm.Wnd := Longint(Value.Handle);
  1391.     FError := mciSendCommand( FDeviceID, mci_Window, FFlags, Longint(@AWindowParm) );
  1392.     if FError <> 0 then
  1393.       FDisplay := nil {alternate window not supported}
  1394.     else
  1395.     begin
  1396.       FDisplay := Value; {alternate window supported}
  1397.       Value.FreeNotification(Self);
  1398.     end;
  1399.   end
  1400.   else FDisplay := Value;
  1401. end;
  1402.  
  1403. procedure TMediaPlayer.Notification(AComponent: TComponent;
  1404.   Operation: TOperation);
  1405. begin
  1406.   inherited Notification(AComponent, Operation);
  1407.   if (Operation = opRemove) and (AComponent = FDisplay) then
  1408.   begin
  1409.     if MCIOpened then SetOrigDisplay;
  1410.     FDisplay := nil;
  1411.   end;
  1412. end;
  1413.  
  1414. { special case to set video display back to original window,
  1415.   when FDisplay's TWinControl is deleted at runtime }
  1416. procedure TMediaPlayer.SetOrigDisplay;
  1417. var
  1418.   AWindowParm: TMCI_Anim_Window_Parms;
  1419. begin
  1420.   if MCIOpened and FHasVideo then
  1421.   begin
  1422.     FFlags := mci_Wait or mci_Anim_Window_hWnd;
  1423.     AWindowParm.Wnd := mci_Anim_Window_Default;
  1424.     FError := mciSendCommand( FDeviceID, mci_Window, FFlags, Longint(@AWindowParm) );
  1425.   end;
  1426. end;
  1427.  
  1428. {setting a rect for user-defined form to display video devices' output}
  1429. procedure TMediaPlayer.SetDisplayRect( Value: TRect );
  1430. var
  1431.   RectParms: TMCI_Anim_Rect_Parms;
  1432.   WorkR: TRect;
  1433. begin
  1434.   if MCIOpened and FHasVideo then
  1435.   begin
  1436.     {special case, use default width and height}
  1437.     if (Value.Bottom = 0) and (Value.Right = 0) then
  1438.     begin
  1439.       with Value do
  1440.         WorkR := Rect(Left, Top, FDWidth, FDHeight);
  1441.     end
  1442.     else WorkR := Value;
  1443.     FFlags := mci_Anim_RECT or mci_Anim_Put_Destination;
  1444.     RectParms.rc := WorkR;
  1445.     FError := mciSendCommand( FDeviceID, mci_Put, FFlags, Longint(@RectParms) );
  1446.   end;
  1447. end;
  1448.  
  1449.  
  1450. {***** functions to get device capabilities and status ***}
  1451.  
  1452. function TMediaPlayer.GetDisplayRect: TRect;
  1453. var
  1454.   RectParms: TMCI_Anim_Rect_Parms;
  1455. begin
  1456.   if MCIOpened and FHasVideo then
  1457.   begin
  1458.     FFlags := mci_Anim_Where_Destination;
  1459.     FError := mciSendCommand( FDeviceID, mci_Where, FFlags, Longint(@RectParms) );
  1460.     Result := RectParms.rc;
  1461.   end;
  1462. end;
  1463.  
  1464. { fills in static properties upon opening MCI Device }
  1465. procedure TMediaPlayer.GetDeviceCaps;
  1466. var
  1467.   DevCapParm: TMCI_GetDevCaps_Parms;
  1468.   devType: Longint;
  1469.   RectParms: TMCI_Anim_Rect_Parms;
  1470.   WorkR: TRect;
  1471. begin
  1472.   FFlags := mci_Wait or mci_GetDevCaps_Item;
  1473.  
  1474.   DevCapParm.dwItem := mci_GetDevCaps_Can_Play;
  1475.   mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  1476.   FCanPlay := Boolean(DevCapParm.dwReturn);
  1477.   if FCanPlay then Include(FCapabilities, mpCanPlay);
  1478.  
  1479.   DevCapParm.dwItem := mci_GetDevCaps_Can_Record;
  1480.   mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  1481.   FCanRecord := Boolean(DevCapParm.dwReturn);
  1482.   if FCanRecord then Include(FCapabilities, mpCanRecord);
  1483.  
  1484.   DevCapParm.dwItem := mci_GetDevCaps_Can_Eject;
  1485.   mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  1486.   FCanEject := Boolean(DevCapParm.dwReturn);
  1487.   if FCanEject then Include(FCapabilities, mpCanEject);
  1488.  
  1489.   DevCapParm.dwItem := mci_GetDevCaps_Has_Video;
  1490.   mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  1491.   FHasVideo := Boolean(DevCapParm.dwReturn);
  1492.   if FHasVideo then Include(FCapabilities, mpUsesWindow);
  1493.  
  1494.   DevCapParm.dwItem := mci_GetDevCaps_Device_Type;
  1495.   mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  1496.   devType := DevCapParm.dwReturn;
  1497.   if (devType = mci_DevType_Animation) or
  1498.      (devType = mci_DevType_Digital_Video) or
  1499.      (devType = mci_DevType_Overlay) or
  1500.      (devType = mci_DevType_VCR) then FCanStep := True;
  1501.   if FCanStep then Include(FCapabilities, mpCanStep);
  1502.  
  1503.   FFlags := mci_Anim_Where_Source;
  1504.   FError := mciSendCommand( FDeviceID, mci_Where, FFlags, Longint(@RectParms) );
  1505.   WorkR := RectParms.rc;
  1506.   FDWidth := WorkR.Right - WorkR.Left;
  1507.   FDHeight := WorkR.Bottom - WorkR.Top;
  1508. end; {GetDeviceCaps}
  1509.  
  1510. function TMediaPlayer.GetStart: Longint;
  1511. var
  1512.   StatusParm: TMCI_Status_Parms;
  1513. begin
  1514.   CheckIfOpen; {raises exception if device is not open}
  1515.   FFlags := mci_Wait or mci_Status_Item or mci_Status_Start;
  1516.   StatusParm.dwItem := mci_Status_Position;
  1517.   FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  1518.   Result := StatusParm.dwReturn;
  1519. end;
  1520.  
  1521. function TMediaPlayer.GetLength: Longint;
  1522. var
  1523.   StatusParm: TMCI_Status_Parms;
  1524. begin
  1525.   CheckIfOpen; {raises exception if device is not open}
  1526.   FFlags := mci_Wait or mci_Status_Item;
  1527.   StatusParm.dwItem := mci_Status_Length;
  1528.   FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  1529.   Result := StatusParm.dwReturn;
  1530. end;
  1531.  
  1532. function TMediaPlayer.GetTracks: Longint;
  1533. var
  1534.   StatusParm: TMCI_Status_Parms;
  1535. begin
  1536.   CheckIfOpen; {raises exception if device is not open}
  1537.   FFlags := mci_Wait or mci_Status_Item;
  1538.   StatusParm.dwItem := mci_Status_Number_Of_Tracks;
  1539.   FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  1540.   Result := StatusParm.dwReturn;
  1541. end;
  1542.  
  1543. function TMediaPlayer.GetMode: TMPModes;
  1544. var
  1545.   StatusParm: TMCI_Status_Parms;
  1546. begin
  1547.   FFlags := mci_Wait or mci_Status_Item;
  1548.   StatusParm.dwItem := mci_Status_Mode;
  1549.   FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  1550.   Result := TMPModes(StatusParm.dwReturn - 524); {MCI Mode #s are 524+enum}
  1551. end;
  1552.  
  1553. function TMediaPlayer.GetPosition: Longint;
  1554. var
  1555.   StatusParm: TMCI_Status_Parms;
  1556. begin
  1557.   FFlags := mci_Wait or mci_Status_Item;
  1558.   StatusParm.dwItem := mci_Status_Position;
  1559.   FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  1560.   Result := StatusParm.dwReturn;
  1561. end;
  1562.  
  1563. function TMediaPlayer.GetTimeFormat: TMPTimeFormats;
  1564. var
  1565.   StatusParm: TMCI_Status_Parms;
  1566. begin
  1567.   CheckIfOpen; {raises exception if device is not open}
  1568.   FFlags := mci_Wait or mci_Status_Item;
  1569.   StatusParm.dwItem := mci_Status_Time_Format;
  1570.   FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  1571.   Result := TMPTimeFormats(StatusParm.dwReturn);
  1572. end;
  1573.  
  1574. function TMediaPlayer.GetErrorMessage: string;
  1575. var
  1576.   ErrMsg: array[0..4095] of Char;
  1577. begin
  1578.   if not mciGetErrorString(FError, ErrMsg, SizeOf(ErrMsg)) then
  1579.     Result := SMCIUnknownError
  1580.   else SetString(Result, ErrMsg, StrLen(ErrMsg));
  1581. end;
  1582.  
  1583. end.
  1584.