Firemonkey TTimer はざっくりしすぎているので、TStopWatch を使って正確な時間を測る。
これでずいぶん正確になった。


unit untTaskIndicater;

interface

uses
  untViewer,
  untWordDic,
  untWaveFilePlayer,
  untClientManager,

  System.Diagnostics,
  MMsystem,
  FMX.Filter.Effects,
  FMX.Objects,
  FMX.Types,
  FMX.Dialogs,
  System.Types,
  System.UITypes,
  SysUtils;

const
  CLOCK_INTERVAL = 5;

type
  TTaskIndicator = class
  private

    FWordRecord: TWordRecord;
    FRoughTimer: TTimer;
    FIndicatingIndex: Integer;

    FIsVoiceOnly: Boolean;
    FStopwatch :TStopwatch;

    procedure OnRoughTimer(Sender: TObject);
  public
    constructor Create();
    destructor Destroy(); override;

    procedure Reset();
    procedure Indicate(aWordRecord: TWordRecord; aIsVoiceOnly: Boolean);

  end;

implementation

uses
  untModel,
  untMainForm;

constructor TTaskIndicator.Create;
begin
  FStopwatch.Create;

  FRoughTimer := TTimer.Create(nil);
  FRoughTimer.OnTimer  := OnRoughTimer;
  FRoughTimer.Enabled  := False;
  FRoughTimer.Interval := CLOCK_INTERVAL;
end;

destructor TTaskIndicator.Destroy;
begin

  FRoughTimer.Free;
  inherited;
end;

procedure TTaskIndicator.Indicate(aWordRecord: TWordRecord; aIsVoiceOnly: Boolean);
var
  i: Integer;
begin
  FIsVoiceOnly := aIsVoiceOnly;
  FWordRecord := aWordRecord;

  Viewer.DispAllPlanes();

  // タイマーが動く前に再生開始が望ましい
  WaveFilePlayer.Play(FWordRecord.VoiceStream);

  FRoughTimer.Enabled  := True;
  FStopwatch.Reset;
  FStopwatch.Start;

  FIndicatingIndex := -1;

end;

procedure TTaskIndicator.OnRoughTimer(Sender: TObject);
var
  tmpTime: Integer;
begin
  // For Pause
  if Model.IsPausing then Exit;

   tmpTime := FStopwatch.ElapsedMilliseconds;

  // 終了条件
  if FWordRecord.IndicateScheduleArray[Length(FWordRecord.IndicateScheduleArray)-1].EndTime <= tmpTime then
  begin
    Viewer.DeAccentPlane(Length(FWordRecord.IndicateScheduleArray)-1);
    if not FIsVoiceOnly then Viewer.DispAllPlanes();
    FRoughTimer.Enabled := False;
    FStopwatch.Stop;
    Model.onIndicaterFinished(); // 終わりを知らせる
  end;

  if not FIsVoiceOnly then
  begin
   if FWordRecord.IndicateScheduleArray[FIndicatingIndex+1].StartTime <= tmpTime then
   begin
     FIndicatingIndex := FIndicatingIndex + 1;

     if FIndicatingIndex <> 0 then Viewer.DeAccentPlane(FIndicatingIndex-1);
     Viewer.AccentPlane(FIndicatingIndex);
   end;
  end;

end;

procedure TTaskIndicator.Reset;
begin
  FRoughTimer.Enabled := False;
end;

end.