tetimed.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

unit teTimed;

interface

{$INCLUDE teDefs.inc}

uses
  {$IFDEF WIN32}
  Windows, Messages,
  {$ENDIF WIN32}
  SysUtils, Classes, TransEff, teChrono,
  {$ifdef CLX}
  QT, QGraphics, QControls;
  {$else}
  Graphics;//, Controls;
  {$endif CLX}

type
{$ifdef LogTiming}
  TTrace = record
    Index: Integer;
    CurrentFrame: Integer;
    Step,
    TransitionTime,
    StepTime,
    WorkTime,
    SleepTime,
    LastUpdateTime,
    ExTime,
    Fps,
    Interval,
    Margin: Single;
  end;
{$endif LogTiming}

  TTimedTransitionEffect = class(TTransitionEffect)
  private
    SleepChrono: TTEChrono;
  protected
{$ifdef LogTiming}
    Trace: Array [0..80000] of TTrace;
    TraceIndex: Integer;
    CronoExtra: TTEChrono;
{$endif LogTiming}
    procedure Initialize(Data: TTETransitionData;
      var Frames: Longint); virtual;
    procedure Finalize(Data: TTETransitionData); virtual;
    procedure DoExecute(Data: TTETransitionData); override;
    procedure FirstFrame(TotalFrames: Longint; Milliseconds: Longint; //V34
                         MinStepValue: Longint; var Interval: Single;
                         var LastWorkTime: Single; var Step: Single);
    procedure NextFrame(Data: TTETransitionData; InternalLoop: Boolean; //V34
                              TotalFrames: Longint; CurrentFrame: Longint;
                              Milliseconds: Longint; ElapsedTime: Longint;
                              MinStepValue: Longint; Chrono: TTEChrono;
                              var Interval: Single; var LastWorkTime: Single;
                              var LastUpdateTime: Single; var StepStartTime: Single;
                              var Step: Single);
    procedure DoTimedExecute(MinStepValue, TotalFrames: Longint;
      Data: TTETransitionData); virtual;
    procedure ExecuteFrame(Data: TTETransitionData; CurrentFrame,
      Step, TotalFrames, LastExecutedFrame: Longint); virtual;
    function MinStep: Integer; virtual;
  public
    constructor Create(AOwner: TComponent{$ifdef DP} = nil{$endif}); override;
    destructor  Destroy; override;
  published
    property Milliseconds;
  end;

implementation

uses MMSystem;

{ TTimedTransitionEffect }
constructor TTimedTransitionEffect.Create(AOwner: TComponent);
begin
  inherited;

  SleepChrono := TTEChrono.Create;
end;

destructor TTimedTransitionEffect.Destroy;
begin
  SleepChrono.Free;
  
  inherited;
end;

procedure TTimedTransitionEffect.ExecuteFrame(Data: TTETransitionData;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Integer);
begin
  CheckAbort(True); //V33
end;

procedure TTimedTransitionEffect.DoExecute(Data: TTETransitionData);
var
  MinStepValue,
  TotalFrames,
  i: Longint;
begin
  CheckAbort(False);
  If Aborted Then Exit;  //V33
  Initialize(Data, TotalFrames);
  try
    CheckAbort(False);
    If Not Aborted Then   //V33
    Begin
      MinStepValue := MinStep;
      if Milliseconds <= 0 then
      begin
        if TotalFrames <= 0 then
          SysUtils.Abort;
        OffScreenBmp := Data.Bitmap;
        i := MinStepValue;
        while i < TotalFrames do
        begin
          ExecuteFrame(Data, i, MinStepValue, TotalFrames, i-MinStepValue);
          if Aborted then break;
           UpdateScreen(False);
           Inc(i, MinStepValue);
        end;
      {$ifndef CLX}
        SelectPalette(RenderWindow.Canvas.Handle, RenderWindow.Palette, True);
        BitBlt(RenderWindow.Canvas.Handle, 0, 0, Data.Width, Data.Height,
          Data.DstBmp.Canvas.Handle, 0, 0, cmSrcCopy);
      {$else}
        Windows.BitBlt(QPainter_handle(RenderWindow.Canvas.Handle), 0, 0,
          Data.Width, Data.Height,
          QPainter_handle(Data.DstBmp.Canvas.Handle), 0, 0, SRCCOPY);
      {$endif CLX}
      end
      else
      begin
        if TotalFrames <= 0 then
          SysUtils.Abort;
        OffScreenBmp := Data.Bitmap;
        DoTimedExecute(MinStepValue, TotalFrames, Data);
      end;
    End;
  finally
    Finalize(Data);
    OffScreenBmp := nil;
  end;
end;
//V34

procedure TTimedTransitionEffect.FirstFrame(TotalFrames: Longint;
          Milliseconds: Longint; MinStepValue: Longint; var Interval: Single;
          var LastWorkTime: Single; var Step: Single);
Begin
  Interval := Milliseconds / TotalFrames;
  LastWorkTime     := Interval;
  Step := TotalFrames / (Milliseconds / Interval);
  if Step < MinStepValue then
    Step := MinStepValue;
  if Step > TotalFrames then
    Step := TotalFrames;
End;

procedure TTimedTransitionEffect.NextFrame(Data: TTETransitionData;
          InternalLoop: Boolean; TotalFrames: Longint; CurrentFrame: Longint;
          Milliseconds: Longint; ElapsedTime: Longint; MinStepValue: Longint;
          Chrono: TTEChrono; var Interval: Single; var LastWorkTime: Single;
          var LastUpdateTime: Single; var StepStartTime: Single; var Step: Single);
var
  SaveLastUpdateTime: Single;
  Time: Single;
  LastStepStartTime: Single;
  SleepTime: Single;
  UpdateScreenTime: Single;

  procedure GoToBed(ms: Single);
  Begin
    if ms <= 0 then exit;

    SleepChrono.Start;

    while SleepChrono.Milliseconds < ms do;
    SleepChrono.Reset;
  end;

  procedure CalculateParameters(MinStepValue: Longint; TotalFrames: Longint;
            CurrentFrame: Longint; TotalMilliseconds: Double;
            TransitionTime: Double; LastStepStartTime: Double;
            SleepTime: Double; var Interval: Single; var LastWorkTime: Single;
            var Step: Single);
  var
    FramesToEnd: Longint;
    TimeToGo: Single;
    WorkTime: Single;
  Begin
    WorkTime := (TransitionTime - LastStepStartTime) - SleepTime;
    FramesToEnd      := TotalFrames - CurrentFrame;
    TimeToGo         := TotalMilliseconds - TransitionTime;
    if TimeToGo <= 0
    then Step := FramesToEnd
    else
    begin
      Interval := WorkTime;
      Step := FramesToEnd / ((TotalMilliseconds - TransitionTime) / Interval);
      if Step < MinStepValue
      then Step := MinStepValue
      else
      begin
        if(MinStepValue > 1) and ((Round(Step) mod MinStepValue) <> 0) then
          Step := MinStepValue * ((Round(Step) div MinStepValue) + 1);
      end;
      if Step > FramesToEnd then
        Step := FramesToEnd;
    end;

    Interval := (TotalMilliseconds - TransitionTime) / (FramesToEnd / Step);
    LastWorkTime := WorkTime;
  end;

Begin
  SaveLastUpdateTime := LastUpdateTime;
  If InternalLoop Then
  Begin
    UpdateScreenTime := Chrono.Milliseconds;
    UpdateScreen(False);
    LastUpdateTime := Chrono.Milliseconds - UpdateScreenTime;
    Time := Chrono.Milliseconds;
    If Data.RealTime Then
      GoToBed(Interval - SaveLastUpdateTime - (Time - StepStartTime));
    SleepTime := Chrono.Milliseconds - Time;
    LastStepStartTime := StepStartTime;
    StepStartTime := Chrono.Milliseconds;

    CalculateParameters(MinStepValue,TotalFrames,CurrentFrame,Milliseconds,
          Chrono.Milliseconds,LastStepStartTime,SleepTime,Interval,LastWorkTime,
          Step);
    {$ifdef LogTiming}
    Trace[TraceIndex].CurrentFrame   := Round(CurrentFrame);
    Trace[TraceIndex].Step           := Step;
    Trace[TraceIndex].TransitionTime := TransitionChrono.Milliseconds;
    Trace[TraceIndex].StepTime       := StepStartTime - LastStepStartTime;
    Trace[TraceIndex].WorkTime       := (StepStartTime - LastStepStartTime) - SleepTime;
    Trace[TraceIndex].SleepTime      := SleepTime;
    Trace[TraceIndex].LastUpdateTime := LastUpdateTime;
    Trace[TraceIndex].Fps            := 1000 / (StepStartTime - LastStepStartTime);
    Trace[TraceIndex].Interval       := Interval;
    Trace[TraceIndex].Margin         := Interval - LastWorkTime;
    Inc(TraceIndex);
    {$endif LogTiming}
  End
  Else
  Begin
    Chrono.Start;
    UpdateScreen(False);
    LastUpdateTime := Chrono.Milliseconds;
    Time := Chrono.Milliseconds+ElapsedTime;
    If Data.RealTime Then
      GoToBed(Interval - SaveLastUpdateTime - (Time - StepStartTime));
    SleepTime := ElapsedTime + Chrono.Milliseconds - Time;
    LastStepStartTime := StepStartTime;
    StepStartTime := ElapsedTime+Chrono.Milliseconds;

    CalculateParameters(MinStepValue,TotalFrames,CurrentFrame,Milliseconds,
          Chrono.Milliseconds+ElapsedTime,LastStepStartTime,SleepTime,Interval,
          LastWorkTime,Step);

    {$ifdef LogTiming}
    Trace[TraceIndex].CurrentFrame   := Round(CurrentFrame);
    Trace[TraceIndex].Step           := Step;
    Trace[TraceIndex].TransitionTime := TransitionChrono.Milliseconds;
    Trace[TraceIndex].StepTime       := StepStartTime - LastStepStartTime;
    Trace[TraceIndex].WorkTime       := (StepStartTime - LastStepStartTime) - SleepTime;
    Trace[TraceIndex].SleepTime      := SleepTime;
    Trace[TraceIndex].LastUpdateTime := LastUpdateTime;
    Trace[TraceIndex].Fps            := 1000 / (StepStartTime - LastStepStartTime);
    Trace[TraceIndex].Interval       := Interval;
    Trace[TraceIndex].Margin         := Interval - LastWorkTime;
    Inc(TraceIndex);
    {$endif LogTiming}
    Chrono.Reset;
  End;
end; //EROC itnA

//V34 End
procedure TTimedTransitionEffect.DoTimedExecute(MinStepValue,
                                                TotalFrames: Longint;
                                                Data: TTETransitionData);
var
  LastExecutedFrame,
  CurrentFrame: Longint;
  Step,
  LastWorkTime,
  LastUpdateTime,
  StepStartTime,
  Interval: Single;
  TransitionChrono: TTEChrono;
{$ifdef LogTiming}
  Fic: TextFile;
  i: Integer;
  DC: Hdc;
  FileName: String;
  WriteToFile: Boolean;
  TotExtra,
  TotSleep: Single;
{$endif LogTiming}
begin
{$ifdef LogTiming}
  for i:= 0 to 1000 do
  begin
    Trace[i].Index          := i;
    Trace[i].CurrentFrame   := 0;
    Trace[i].Step           := 0;
    Trace[i].TransitionTime := 0;
    Trace[i].StepTime       := 0;
    Trace[i].WorkTime       := 0;
    Trace[i].SleepTime      := 0;
    Trace[i].LastUpdateTime := 0;
    Trace[i].ExTime         := 0;
    Trace[i].Fps            := 0;
    Trace[i].Interval       := 0;
    Trace[i].Margin         := 0;
  end;
  TraceIndex := 0;
  CronoExtra := TTEChrono.Create;
{$endif LogTiming}

  Interval         := 0;
  LastUpdateTime   := 0;
  StepStartTime    := 0;
  Step             := 1;
  TransitionChrono := nil;

  try
    FirstFrame(TotalFrames,
               Milliseconds,
               MinStepValue,
               Interval,
               LastWorkTime,
               Step);
    TransitionChrono  := TTEChrono.Create;
    CurrentFrame      := Round(Step);
    LastExecutedFrame := 0;
    TransitionChrono.Start;
    While CurrentFrame<TotalFrames Do    //V34
    Begin
      ExecuteFrame(Data,
                   CurrentFrame,
                   CurrentFrame - LastExecutedFrame,
                   TotalFrames,
                   LastExecutedFrame);
      if Aborted then  break;
      LastExecutedFrame := CurrentFrame;
      NextFrame(Data,
                True,
                TotalFrames,
                CurrentFrame,
                Milliseconds,
                Round(TransitionChrono.Milliseconds),
                MinStepValue,
                TransitionChrono,
                Interval,
                LastWorkTime,
                LastUpdateTime,
                StepStartTime,
                Step);                            
      CurrentFrame := Round(CurrentFrame + Step);
    End;
    {$ifndef CLX}
    SelectPalette(RenderWindow.Canvas.Handle, RenderWindow.Palette, True);
    BitBlt(RenderWindow.Canvas.Handle, 0, 0, Data.Width, Data.Height,
      Data.DstBmp.Canvas.Handle, 0, 0, cmSrcCopy);
    {$else}
    Windows.BitBlt(QPainter_handle(RenderWindow.Canvas.Handle), 0, 0,
      Data.Width, Data.Height, QPainter_handle(Data.DstBmp.Canvas.Handle), 0, 0,
      SRCCOPY);
    {$endif CLX}
    TransitionChrono.Pause;

  {$ifdef LogTiming}
    WriteToFile := CompareText(ExtractFileName(Application.ExeName), 'DELPHI32.EXE') <> 0;

    if WriteToFile then
    begin
      i := 0;
      FileName := ExtractFilePath(Application.ExeName) + 'Log.txt';
      AssignFile(Fic, FileName);
      if FileExists(FileName)
      then Append (Fic)
      else Rewrite(Fic);
      DC := GetDC(0);
      try
        Writeln(Fic, ClassName + '; ' + IntToStr(Milliseconds) + ' ms; (' +
          IntToStr(Data.Width) + 'x' + IntToStr(Data.Height) +
          '); ' + IntToStr(TraceIndex) + '/' + IntToStr(TotalFrames-1) + ' frames; ' +
          IntToStr(GetDeviceCaps(DC, BITSPIXEL)) + ' bpp');
      finally
        ReleaseDC(0, DC);
      end;
      TotExtra := 0;
      TotSleep := 0;
      Writeln(Fic);
      Writeln(Fic, 'Index CurFrame    Step TransTime StepTime WorkTime SleepTime LUpdTime   ExTime      Fps Interval');// Margin');
      while Trace[i].Step <> 0 do
      begin
        Writeln(Fic,
          Format('%5d %8d %7.2n %9.2n %8.2n %8.2n %9.2n %8.2n %8.2n %8.2n %8.2n'{ %6.2n'},
            [Trace[i].Index,
             Trace[i].CurrentFrame,
             Trace[i].Step,
             Trace[i].TransitionTime,
             Trace[i].StepTime,
             Trace[i].WorkTime,
             Trace[i].SleepTime,
             Trace[i].LastUpdateTime,
             Trace[i].ExTime,
             Trace[i].Fps,
             Trace[i].Interval{,
             Trace[i].Margin}]));
        Inc(i);
        TotExtra := TotExtra + Trace[i].ExTime;
        TotSleep := TotSleep + Trace[i].SleepTime;
      end;
      CronoExtra.Free;
      Writeln(Fic);
      if RefreshTimer.Milliseconds > 0 then
        Writeln(Fic, 'RefreshTimer = ' +
          IntToStr(Round(RefreshTimer.Milliseconds)) + ' ms; ' +
          IntToStr(RefreshTimer.Passes) + ' passes; ' +
            IntToStr(Trunc((RefreshTimer.Passes * 1000) / RefreshTimer.Milliseconds)) +
              ' fps');
      Writeln(Fic,
        'TransitionTime = ' + IntToStr(Round(TransitionChrono.Milliseconds)) + '; ' +
        IntToStr(Round((RefreshTimer.Passes * 1000) / TransitionChrono.Milliseconds)) +
          ' fps; ExtraTime = ' + IntToStr(Round(TotExtra)) + '; SleepTime = ' +
          IntToStr(Round(TotSleep)));
      Writeln(Fic, '-----------------------------------------------------------------');
      CloseFile(Fic);
    end;
    RefreshTimer.Reset;
  {$endif LogTiming}
  finally
    TransitionChrono.Free;
    OffScreenBmp := nil;
  end;
end;



procedure TTimedTransitionEffect.Initialize(Data: TTETransitionData;
  var Frames: Integer);
begin
  DirtyRects := TFCDirtyRects.Create;
  DirtyRects.Bounds := Rect(0, 0, Data.Width, Data.Height);
end;

procedure TTimedTransitionEffect.Finalize(Data: TTETransitionData);
begin
  DirtyRects.Free;
end;

function TTimedTransitionEffect.MinStep: Integer;
begin
  Result := 1;
end;

end.