mplayer.pas

这是不可多得的源代码

    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    FFlags := FFlags or mci_Anim_Step_Frames;
    AStepParm.dwFrames := FFrames;
    AStepParm.dwCallback := Handle;
    FError := mciSendCommand( FDeviceID, mci_Step, FFlags, Longint(@AStepParm) );
  end; {if HasVideo}
end;

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

  if FHasVideo then
  begin
    FFlags := 0;
    if FUseWait then
    begin
      if FWait then FFlags := mci_Wait;
      FUseWait := False;
    end
    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    FFlags := FFlags or mci_Anim_Step_Frames or mci_Anim_Step_Reverse;
    AStepParm.dwFrames := FFrames;
    AStepParm.dwCallback := Handle;
    FError := mciSendCommand( FDeviceID, mci_Step, FFlags, Longint(@AStepParm) );
  end; {if HasVideo}
end; {Back}

procedure TMediaPlayer.Eject;
var
  SetParm: TMCI_Set_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

  if FCanEject then
  begin
    FFlags := 0;
    if FUseWait then
    begin
      if FWait then FFlags := mci_Wait;
      FUseWait := False;
    end
    else FFlags := mci_Wait;
    if FUseNotify then
    begin
      if FNotify then FFlags := FFlags or mci_Notify;
      FUseNotify := False;
    end;
    FFlags := FFlags or mci_Set_Door_Open;
    SetParm.dwCallback := Handle;
    FError := mciSendCommand( FDeviceID, mci_Set, FFlags, Longint(@SetParm) );
  end; {if CanEject}
end; {Eject}

procedure TMediaPlayer.SetPosition(Value: Longint);
var
  SeekParm: TMCI_Seek_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}

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

procedure TMediaPlayer.Rewind;
var
  SeekParm: TMCI_Seek_Parms;
  RFlags: Longint;
begin
  CheckIfOpen; {raises exception if device is not open}
  RFlags := mci_Wait or mci_Seek_To_Start;
  mciSendCommand( FDeviceID, mci_Seek, RFlags, Longint(@SeekParm));
end;

function TMediaPlayer.GetTrackLength(TrackNum: Integer): Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}
  FFlags := mci_Wait or mci_Status_Item or mci_Track;
  StatusParm.dwItem := mci_Status_Length;
  StatusParm.dwTrack := Longint(TrackNum);
  mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.GetTrackPosition(TrackNum: Integer): Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  FFlags := mci_Wait or mci_Status_Item or mci_Track;
  StatusParm.dwItem := mci_Status_Position;
  StatusParm.dwTrack := Longint(TrackNum);
  mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

procedure TMediaPlayer.Save;
var
  SaveParm: TMCI_SaveParms;
begin
  CheckIfOpen; {raises exception if device is not open}
  if FElementName <> '' then {make sure a file has been specified to save to}
  begin
    SaveParm.lpfilename := PChar(FElementName);

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


{*** procedures that set control flags for MCI Commands ***}
procedure TMediaPlayer.SetWait( Flag: Boolean );
begin
  if Flag <> FWait then FWait := Flag;
  FUseWait := True;
end;

procedure TMediaPlayer.SetNotify( Flag: Boolean );
begin
  if Flag <> FNotify then FNotify := Flag;
  FUseNotify := True;
end;

procedure TMediaPlayer.SetFrom( Value: Longint );
begin
  if Value <> FFrom then FFrom := Value;
  FUseFrom := True;
end;

procedure TMediaPlayer.SetTo( Value: Longint );
begin
  if Value <> FTo then FTo := Value;
  FUseTo := True;
end;


procedure TMediaPlayer.SetDeviceType( Value: TMPDeviceTypes );
begin
  if Value <> FDeviceType then FDeviceType := Value;
end;

procedure TMediaPlayer.SetTimeFormat( Value: TMPTimeFormats );
var
  SetParm: TMCI_Set_Parms;
begin
  begin
    FFlags := mci_Notify or mci_Set_Time_Format;
    SetParm.dwTimeFormat := Longint(Value);
    FError := mciSendCommand( FDeviceID, mci_Set, FFlags, Longint(@SetParm) );
  end;
end;

{setting a TWinControl to display video devices' output}
procedure TMediaPlayer.SetDisplay( Value: TWinControl );
var
  AWindowParm: TMCI_Anim_Window_Parms;
begin
  if (Value <> nil) and MCIOpened and FHasVideo then
  begin
    FFlags := mci_Wait or mci_Anim_Window_hWnd;
    AWindowParm.Wnd := Longint(Value.Handle);
    FError := mciSendCommand( FDeviceID, mci_Window, FFlags, Longint(@AWindowParm) );
    if FError <> 0 then
      FDisplay := nil {alternate window not supported}
    else
    begin
      FDisplay := Value; {alternate window supported}
      Value.FreeNotification(Self);
    end;
  end
  else FDisplay := Value;
end;

procedure TMediaPlayer.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FDisplay) then
  begin
    if MCIOpened then SetOrigDisplay;
    FDisplay := nil;
  end;
end;

{ special case to set video display back to original window,
  when FDisplay's TWinControl is deleted at runtime }
procedure TMediaPlayer.SetOrigDisplay;
var
  AWindowParm: TMCI_Anim_Window_Parms;
begin
  if MCIOpened and FHasVideo then
  begin
    FFlags := mci_Wait or mci_Anim_Window_hWnd;
    AWindowParm.Wnd := mci_Anim_Window_Default;
    FError := mciSendCommand( FDeviceID, mci_Window, FFlags, Longint(@AWindowParm) );
  end;
end;

{setting a rect for user-defined form to display video devices' output}
procedure TMediaPlayer.SetDisplayRect( Value: TRect );
var
  RectParms: TMCI_Anim_Rect_Parms;
  WorkR: TRect;
begin
  if MCIOpened and FHasVideo then
  begin
    {special case, use default width and height}
    if (Value.Bottom = 0) and (Value.Right = 0) then
    begin
      with Value do
        WorkR := Rect(Left, Top, FDWidth, FDHeight);
    end
    else WorkR := Value;
    FFlags := mci_Anim_RECT or mci_Anim_Put_Destination;
    RectParms.rc := WorkR;
    FError := mciSendCommand( FDeviceID, mci_Put, FFlags, Longint(@RectParms) );
  end;
end;


{***** functions to get device capabilities and status ***}

function TMediaPlayer.GetDisplayRect: TRect;
var
  RectParms: TMCI_Anim_Rect_Parms;
begin
  if MCIOpened and FHasVideo then
  begin
    FFlags := mci_Anim_Where_Destination;
    FError := mciSendCommand( FDeviceID, mci_Where, FFlags, Longint(@RectParms) );
    Result := RectParms.rc;
  end;
end;

{ fills in static properties upon opening MCI Device }
procedure TMediaPlayer.GetDeviceCaps;
var
  DevCapParm: TMCI_GetDevCaps_Parms;
  devType: Longint;
  RectParms: TMCI_Anim_Rect_Parms;
  WorkR: TRect;
begin
  FFlags := mci_Wait or mci_GetDevCaps_Item;

  DevCapParm.dwItem := mci_GetDevCaps_Can_Play;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  FCanPlay := Boolean(DevCapParm.dwReturn);
  if FCanPlay then Include(FCapabilities, mpCanPlay);

  DevCapParm.dwItem := mci_GetDevCaps_Can_Record;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  FCanRecord := Boolean(DevCapParm.dwReturn);
  if FCanRecord then Include(FCapabilities, mpCanRecord);

  DevCapParm.dwItem := mci_GetDevCaps_Can_Eject;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  FCanEject := Boolean(DevCapParm.dwReturn);
  if FCanEject then Include(FCapabilities, mpCanEject);

  DevCapParm.dwItem := mci_GetDevCaps_Has_Video;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  FHasVideo := Boolean(DevCapParm.dwReturn);
  if FHasVideo then Include(FCapabilities, mpUsesWindow);

  DevCapParm.dwItem := mci_GetDevCaps_Device_Type;
  mciSendCommand(FDeviceID, mci_GetDevCaps, FFlags,  Longint(@DevCapParm) );
  devType := DevCapParm.dwReturn;
  if (devType = mci_DevType_Animation) or
     (devType = mci_DevType_Digital_Video) or
     (devType = mci_DevType_Overlay) or
     (devType = mci_DevType_VCR) then FCanStep := True;
  if FCanStep then Include(FCapabilities, mpCanStep);

  FFlags := mci_Anim_Where_Source;
  FError := mciSendCommand( FDeviceID, mci_Where, FFlags, Longint(@RectParms) );
  WorkR := RectParms.rc;
  FDWidth := WorkR.Right - WorkR.Left;
  FDHeight := WorkR.Bottom - WorkR.Top;
end; {GetDeviceCaps}

function TMediaPlayer.GetStart: Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}
  FFlags := mci_Wait or mci_Status_Item or mci_Status_Start;
  StatusParm.dwItem := mci_Status_Position;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.GetLength: Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}
  FFlags := mci_Wait or mci_Status_Item;
  StatusParm.dwItem := mci_Status_Length;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.GetTracks: Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}
  FFlags := mci_Wait or mci_Status_Item;
  StatusParm.dwItem := mci_Status_Number_Of_Tracks;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.GetMode: TMPModes;
var
  StatusParm: TMCI_Status_Parms;
begin
  FFlags := mci_Wait or mci_Status_Item;
  StatusParm.dwItem := mci_Status_Mode;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := TMPModes(StatusParm.dwReturn - 524); {MCI Mode #s are 524+enum}
end;

function TMediaPlayer.GetPosition: Longint;
var
  StatusParm: TMCI_Status_Parms;
begin
  FFlags := mci_Wait or mci_Status_Item;
  StatusParm.dwItem := mci_Status_Position;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := StatusParm.dwReturn;
end;

function TMediaPlayer.GetTimeFormat: TMPTimeFormats;
var
  StatusParm: TMCI_Status_Parms;
begin
  CheckIfOpen; {raises exception if device is not open}
  FFlags := mci_Wait or mci_Status_Item;
  StatusParm.dwItem := mci_Status_Time_Format;
  FError := mciSendCommand( FDeviceID, mci_Status, FFlags, Longint(@StatusParm));
  Result := TMPTimeFormats(StatusParm.dwReturn);
end;

function TMediaPlayer.GetErrorMessage: string;
var
  ErrMsg: array[0..4095] of Char;
begin
  if not mciGetErrorString(FError, ErrMsg, SizeOf(ErrMsg)) then
    Result := SMCIUnknownError
  else SetString(Result, ErrMsg, StrLen(ErrMsg));
end;

end.