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