Регуляция скорости воспроизведения видеоплеера в Delphi 12

unit APDifStr1;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  System.Permissions, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics,
  FMX.Dialogs, FMX.Media, {$IFDEF ANDROID} Androidapi.Log, Androidapi.JNIBridge, Androidapi.JNI.Media, Androidapi.Helpers, {$ENDIF}
{$IFDEF MSWINDOWS} Windows, {$ENDIF} FMX.StdCtrls, FMX.Ani, FMX.Layouts, Math, StrUtils,
  FMX.ScrollBox, FMX.Memo, Androidapi.JNI.JavaTypes,
  Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.Widget,
  Androidapi.JNI.App, FMX.Objects,
  FMX.Memo.Types, Data.DB, FireDAC.Stan.Intf, FireDAC.Comp.Client,
  FireDAC.Phys.SQLiteVDataSet, DateUtils, FMX.ExtCtrls,
  System.Math.Vectors, FMX.Controls3D, System.IOUtils, FMX.Controls.Presentation,
  Androidapi.JNI.Os, FMX.Helpers.Android, Androidapi.JNI.Net,
  FMX.Platform.Android, FMX.Media.Android, System.Rtti;
 
type
  TAPDif = class(TForm)
    APVidScrollBox1: TScrollBox;
    APMediaPlayerControl: TMediaPlayerControl;
    APMediaPlayer: TMediaPlayer;
    ApCloseButton: TButton;
    APButton2: TButton;
    APStopButton: TButton;
    APButton5: TButton;
    APButton4: TButton;
    TrackBarSpeed: TTrackBar;
    Button1: TButton;
    SpeedApplyTimer: TTimer;
    procedure APButton2Click(Sender: TObject);
    procedure APStopButtonClick(Sender: TObject);
    procedure APButton4Click(Sender: TObject);
    procedure APButton5Click(Sender: TObject);
    procedure ApCloseButtonClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TrackBarSpeedChange(Sender: TObject);
    procedure SpeedApplyTimerTimer(Sender: TObject);
  {  procedure Button2Click(Sender: TObject);}
  private
    { Private declarations }
  FDesiredPlaybackSpeed: Single;
 
 procedure CopyAssetToDocuments(const AssetFileName: string);
 procedure PlayVideo;
 {procedure SetMediaPlayerSpeed(MediaPlayer: TMediaPlayer; Speed: Single);  }
 procedure APMediaPlayerStateChange(Sender: TObject; NewState: TMediaState);
procedure TrySetSpeedWithRetries(MediaPlayer: TMediaPlayer; Speed: Single; MaxAttempts: Integer = 10; DelayMs: Integer = 200);
  public
    { Public declarations }
  end;
 
type
  TAndroidMediaAccess = class(TAndroidMedia)
  public
  {function GetJMediaPlayer: JMediaPlayer;}
  end;
 
var
  APDif: TAPDif;
  SavedTime: TMediaTime;
 
implementation
 
{$R *.fmx}
 
function GetJMediaPlayer(Media: TMedia): JMediaPlayer;
var
  ctx: TRttiContext;
  t: TRttiType;
  f: TRttiField;
  v: TValue;
  loc: ILocalObject;
  fieldNames: array[0..1] of string;
  i: Integer;
begin
  Result := nil;
  if Media = nil then
    Exit;
 
  // Для отладки можно показывать класс, но не обязательно
  // ShowMessage('Media класс: ' + Media.ClassName);
 
  ctx := TRttiContext.Create;
  t := ctx.GetType(Media.ClassType);
 
  fieldNames[0] := 'FPlayer';
  fieldNames[1] := 'FMediaPlayer'; // альтернативное имя, если в вашей версии так называется
 
  f := nil;
  while t <> nil do
  begin
    for i := Low(fieldNames) to High(fieldNames) do
    begin
      f := t.GetField(fieldNames[i]);
      if Assigned(f) then
        Break;
    end;
    if Assigned(f) then
      Break;
    t := t.BaseType;
  end;
 
  if not Assigned(f) then
  begin
    // Поле не найдено в иерархии классов
    Exit;
  end;
 
  v := f.GetValue(Media);
  if v.IsEmpty then
    Exit; // поле пустое
 
  // Обычно поле представляет собой Java-обёртку (ILocalObject)
  if v.TryAsType<ILocalObject>(loc) then
  begin
    Result := TJMediaPlayer.Wrap(loc.GetObjectID);
  end
  else
  begin
    // Если поле не ILocalObject — пробуем другие варианты или выходим
    Exit;
  end;
end;
 
procedure LogMsg(const Msg: string);
begin
  {$IFDEF ANDROID}
  // Передаем UTF-8 (MarshaledAString -> PAnsiChar)
  __android_log_write(ANDROID_LOG_INFO,
                      MarshaledAString('MyApp'),
                      MarshaledAString(UTF8Encode(Msg)));
  {$ELSEIF DEFINED(MSWINDOWS)}
  OutputDebugString(PChar(Msg));
  {$ELSE}
  Writeln(Msg);
  {$ENDIF}
end;
 
function ApplySpeedToJPlayer(JPlayer: JMediaPlayer; Speed: Single): Boolean;
var
  JParams: JPlaybackParams;
begin
  Result := False;
  if JPlayer = nil then Exit;
  try
    try
      JParams := JPlayer.getPlaybackParams;
    except
      JParams := nil;
    end;
 
    if JParams = nil then
      JParams := TJPlaybackParams.JavaClass.init;
 
    if Speed < 0.1 then Speed := 0.1;
    if Speed > 3.0 then Speed := 3.0;
 
    JParams.setSpeed(Speed);
    JPlayer.setPlaybackParams(JParams);
    Result := True;
  except
    on E: Exception do
    begin
      LogMsg('ApplySpeedToJPlayer error: ' + E.Message);
      Result := False;
    end;
  end;
end;
 
procedure TAPDif.TrySetSpeedWithRetries(MediaPlayer: TMediaPlayer; Speed: Single; MaxAttempts: Integer = 10; DelayMs: Integer = 200);
begin
  TThread.CreateAnonymousThread(
    procedure
    var
      i: Integer;
      JPlayer: JMediaPlayer;
    begin
      for i := 1 to MaxAttempts do
      begin
        if (MediaPlayer = nil) or (MediaPlayer.Media = nil) then
        begin
          Sleep(DelayMs);
          Continue;
        end;
 
        JPlayer := GetJMediaPlayer(MediaPlayer.Media);
        if JPlayer <> nil then
        begin
          TThread.Synchronize(nil,
            procedure
            begin
              ApplySpeedToJPlayer(JPlayer, Speed);
            end);
          Exit;
        end;
 
        Sleep(DelayMs);
      end;
    end).Start;
end;
 
procedure TAPDif.TrackBarSpeedChange(Sender: TObject);
var
  s: Single;
begin
  s := TrackBarSpeed.Value / 100.0; // FMX: Value — Single
  if s < 0.1 then s := 0.1;
  if s > 3.0 then s := 3.0;
  FDesiredPlaybackSpeed := s;
  TrySetSpeedWithRetries(APMediaPlayer, s, 10, 200);
end;
 
procedure TAPDif.APStopButtonClick(Sender: TObject);
begin
  // Сохраняем текущую позицию воспроизведения в секундах
  SavedTime := APMediaPlayer.CurrentTime;
  APMediaPlayer.Stop;
end;
 
procedure TAPDif.APMediaPlayerStateChange(Sender: TObject; NewState: TMediaState);
begin
  if NewState = TMediaState.Playing then
    TrySetSpeedWithRetries(APMediaPlayer, FDesiredPlaybackSpeed);
end;
 
procedure TAPDif.APButton2Click(Sender: TObject);
begin
  CopyAssetToDocuments('AP.mp4');
  PlayVideo;
end;
 
procedure TAPDif.APButton4Click(Sender: TObject);
begin
  APMediaPlayer.Clear;
end;
 
procedure TAPDif.APButton5Click(Sender: TObject);
begin
 // Возобновить
  APMediaPlayer.CurrentTime := SavedTime;
  APMediaPlayer.Play;
end;
 
procedure TAPDif.ApCloseButtonClick(Sender: TObject);
begin
  APDif.Close;
end;
 
procedure TAPDif.CopyAssetToDocuments(const AssetFileName: string);
var
  AssetManager: JObject;
  InputStream: JInputStream;
  OutputStream: TFileStream;
  Buffer: TJavaArray<Byte>;
  ReadBytes: Integer;
  DestFileName: string;
begin
  DestFileName := TPath.Combine(TPath.GetDocumentsPath, AssetFileName);
 
  if not TFile.Exists(DestFileName) then
  begin
    {$IFDEF ANDROID}
    AssetManager := TAndroidHelper.Context.getAssets;
    InputStream := TJAssetManager.Wrap((AssetManager as ILocalObject).GetObjectID).open(StringToJString(AssetFileName));
    OutputStream := TFileStream.Create(DestFileName, fmCreate);
    try
      Buffer := TJavaArray<Byte>.Create(1024);
      try
        repeat
          ReadBytes := InputStream.read(Buffer, 0, Buffer.Length);
          if ReadBytes > 0 then
            OutputStream.Write(Buffer.Data^, ReadBytes);
        until ReadBytes <= 0;
      finally
        Buffer.Free;
      end;
    finally
      OutputStream.Free;
      InputStream.close;
    end;
    {$ELSE}
    raise Exception.Create('CopyAssetToDocuments работает только на Android');
    {$ENDIF}
  end;
end;
 
procedure TAPDif.FormCreate(Sender: TObject);
begin
  TAndroidHelper.Activity.setRequestedOrientation(
  TJActivityInfo.JavaClass.SCREEN_ORIENTATION_LANDSCAPE);
end;
 
procedure TAPDif.PlayVideo;
var
  VideoFilePath: string;
begin
  VideoFilePath := TPath.Combine(TPath.GetDocumentsPath, 'AP.mp4');
  if TFile.Exists(VideoFilePath) then
  begin
    APMediaPlayer.FileName := VideoFilePath;
    APMediaPlayerControl.MediaPlayer := APMediaPlayer;
    APMediaPlayer.Play;
  end
  else
    ShowMessage('Файл не найден: ' + VideoFilePath);
end;
 
procedure TAPDif.SpeedApplyTimerTimer(Sender: TObject);
begin
  SpeedApplyTimer.Enabled := False;
  // Асинхронно устанавливаем — чтобы не блокировать UI
  TrySetSpeedWithRetries(APMediaPlayer, FDesiredPlaybackSpeed, 8, 150);
end; 
end.

VLCPlayer.PlaybackRate := FDesiredPlaybackSpeed;