0

我已经基于 DSPack 附带的 PlayWin 演示构建了一个媒体播放器应用程序。我在 Delphi 10.4 Sydney 中构建了这个。我关注的主要文件类型是 *.mp4。所有这一切都很好。

我想提供移动到当前正在播放的视频中间并继续播放到视频结尾的功能。

我在 StackOverflow 上进行了广泛搜索，并尝试了任何看起来正确的解决方案。没有任何效果。

我目前的尝试是：

procedure TMediaPlayer.btnMoveToMidVideoClick(Sender: TObject);
Var
  sgBefore: String;
  sgAfter: String;
  MediaSeeking: IMediaSeeking;
  Start: Int64;
  Stop: Int64;
begin
  FilterGraph.Active := true;
  VideoWindow.FilterGraph:= FilterGraph;
  FilterGraph.RenderFile('S:\iTube Studio Downloaded\6.5 HP Greyhound Engine\6_5HP_Best Way To Clean a Honda Style Carburetor - Vide0.mp4');
  FilterGraph.QueryInterface(IMediaSeeking, MediaSeeking);

  Start := 1200519 div 2;
  Stop := 1200519;

  MediaSeeking.SetPositions(Start, AM_SEEKING_AbsolutePositioning, Stop, AM_SEEKING_AbsolutePositioning);

  FilterGraph.Play;
end;

我不知道从哪里获得开始和停止的价值。

谁能弄清楚如何移动到当前正在播放的视频的中间？

迪克·马利

先感谢您。

4

1 回答 1

0

我感谢大家的想法。

可以做到，下面是实现它的代码。

Procedure TMediaPlayer.actVideoHalfWayExecute(Sender: TObject);
Var
  inThumbX: Integer;
  inThumbY: Integer;
  R: TRect;
Begin
  FillChar(R, 0, Sizeof(R));
  tbDSTrackBar.Perform(TBM_GETTHUMBRECT, 0, lparam(@r));
  inThumbX := (r.Left + r.Right) Div 2;
  inThumbY := (r.Top + r.Bottom) Div 2;
  tbDSTrackBar.MouseDown(mbLeft, [], inThumbX, inThumbY);
  tbDSTrackBar.Position := tbDSTrackBar.max Div 2;
  Application.processmessages();
  inThumbX := tbDSTrackBar.Width Div 2;
  tbDSTrackBar.MouseUp(mbLeft, [], inThumbX, inThumbY);
  Application.processmessages();
End;

然而，我作弊了。我修改了 DSPack.pas 中的 TDSTrackBar 从

  protected
    {@exclude}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    {@exclude}
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    {@exclude}
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    {@exclude}
    procedure Timer; dynamic;

至

  public
    {@exclude}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    {@exclude}
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    {@exclude}
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    {@exclude}
    procedure Timer; dynamic;

我的目标是移动到视频和轨迹栏的中间点，但是此代码可用于移动视频和轨迹栏中的任何位置。

谢谢

迪克·马利

于 2021-03-14T13:01:34.677 回答