DSPack移动到视频中间的能力

Question

我已经基于DSPack附带的PlayWin演示构建了一个媒体播放器应用程序。我已经在Delphi 10.4的悉尼构建了这个。我关注的主要文件类型是*.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;

我不知道从哪里获取START和STOP值。

有人知道如何移动到当前正在播放的视频的中间吗？

迪克·马利

提前谢谢你。

Answer 1

我感谢你们所有人的想法。

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

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;

我的目标是移动到视频和轨迹条中的中点，但是这个代码可以用来移动视频和轨迹条中的任何地方。

谢谢

迪克·马利