mplayer.pas

这是不可多得的源代码

procedure TMediaPlayer.DoNotify;
begin
  if Assigned(FOnNotify) then FOnNotify(Self);
end;

procedure TMediaPlayer.Updated;
begin
  inherited;
  Adjust;
end;

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

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

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

  FFlags := 0;

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

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

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

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

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

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

  if FError <> 0 then {problem opening device}
    raise EMCIDeviceError.Create(ErrorMessage)
  else {device successfully opened}
  begin
    MCIOpened := True;
    FDeviceID := OpenParm.wDeviceID;
    FFrames := Length div 10;  {default frames to step = 10% of total frames}
    GetDeviceCaps; {must first get device capabilities}
    if FHasVideo then {used for video output positioning}
    begin
      Display := FDisplay; {if one was set in design mode}
      DisplayR := GetDisplayRect;
      FDWidth := DisplayR.Right-DisplayR.Left;
      FDHeight := DisplayR.Bottom-DisplayR.Top;
    end;
    if (FDeviceType = dtCDAudio) or (FDeviceType = dtVideodisc) then
      TimeFormat := tfTMSF; {set timeformat to use tracks}
    
    FAutoButtons := [btNext,btPrev]; {assumed all devices can seek to start, end}
    if FCanStep then FAutoButtons := FAutoButtons + [btStep,btBack];
    if FCanPlay then Include(FAutoButtons, btPlay);
    if FCanRecord then Include(FAutoButtons, btRecord);
    if FCanEject then Include(FAutoButtons, btEject);
    if Mode = mpPlaying then AutoButtonSet(btPlay); {e.g. CD device}
    DrawAutoButtons;
  end;
    
end;

procedure TMediaPlayer.Close;
var
  GenParm: TMCI_Generic_Parms;
begin
  if FDeviceID <> 0 then
  begin
    FFlags := 0;
    if FUseWait then
    begin
      if FWait then FFlags := mci_Wait;
      FUseWait := False;
    end
    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    GenParm.dwCallback := Handle;
    FError := mciSendCommand( FDeviceID, mci_Close, FFlags, Longint(@GenParm));
    if FError = 0 then
    begin
      MCIOpened := False;
      FDeviceID := 0;
      FAutoButtons := [];
      DrawAutoButtons;
    end;
  end; {if DeviceID <> 0}
end;

procedure TMediaPlayer.Play;
var
  PlayParm: TMCI_Play_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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