transeff.pas

delphi2007界面效果控件源码

        if (TransitionThread <> nil)
        then TransitionThread.Synchronize(TransitionThread.OnStart)
        else DelegateTransition.FOnStartTransition(Self);
      end;
    finally
      if (TransitionThread <> nil) then
        LeaveCriticalSection(TransitionThread.CSSync);
    end;
  end;

  if(TransitionThread = nil)                   and
    (
      DelegateTransition.AbortOnClick  or
      DelegateTransition.AbortOnEscape or
      Assigned(DelegateTransition.OnAbortQuery)
    )                                          then
    Data.AbortChrono := TTEChrono.Create;
  try
    if Assigned(Data.AbortChrono) then
      Data.AbortChrono.Start;
    try
      if not CheckAbort(False) then
      begin
        DelegateTransition.Initialize(Data, Data.Frames);
        TransitionInitialized;
        try
          if(Pass2Chrono <> nil) and (Pass = 1) then
            Pass2Chrono.Start;
          if Data.Frames > 0 then
          begin
            {$ifdef LogTiming}
            if Assigned(DelegateTransition.Log) then
              DelegateTransition.Log.SetSize(Data.TotalFrames);
            {$endif LogTiming}
            TransitionChrono := TTEChrono.Create;
            try
              OutOfTime := False;
              if(Pass2Chrono <> nil) and (Pass = 2) then
              begin
                Pass2Chrono.Pause;
                if Round(Pass2Chrono.Milliseconds) < TotalMilliseconds
                then DelegateTransition.Milliseconds :=
                       TotalMilliseconds - Round(Pass2Chrono.Milliseconds)
                else OutOfTime := True;
              end;

              if not OutOfTime then
              begin
                if(DelegateTransition.Milliseconds > 0) and
                  (tetiMillisecondsCapable in DelegateTransition.GetInfo(Self))
                then DoTimedExecution   (Data, TransitionChrono)
                else DoCompleteExecution(Data, TransitionChrono);
              end;
              {$ifdef LogTiming}
              if Assigned(DelegateTransition.Log) then
                DelegateTransition.Log.SaveLog(DelegateTransition, Data,
                  TransitionChrono.Milliseconds);
              {$endif LogTiming}
            finally
              TransitionChrono.Free;
            end;
          end;
        finally
          DelegateTransition.Finalize(Data);
        end;
      end;
    finally
      if(Data.DeviceWnd <> 0) and (Data.Palette <> 0) then
        SelectPalette(Data.DeviceCanvas.Handle, Data.Palette, True);
      if Data.DstBmp <> nil then
      begin
        if(Data.AlwaysShowLastFrame)                 and
          ((not Aborted) or (Pass = Data.PassCount)) then
        begin
          OffsetWindowOrgEx(Data.DeviceCanvas.Handle,
            -Data.DeviceCanvasOrgOff.X, -Data.DeviceCanvasOrgOff.Y, P);
          try
            BitBlt(Data.DeviceCanvas.Handle, 0, 0, Data.Width, Data.Height,
              Data.DstBmp.Canvas.Handle, 0, 0, cmSrcCopy);
          finally
            SetWindowOrgEx(Data.DeviceCanvas.Handle, P.X, P.Y, nil);
          end;
        end;
      end;
    end;
  finally
    FreeAndNil(Data.AbortChrono);
  end;

  if Assigned(DelegateTransition.FOnEndTransition) and
    ((Pass=2) or (Data.PassCount = 1))            then
  begin
    if not Aborted then
    begin
      if TransitionThread <> nil
      then PostponedOnEnd := True
      else
      begin
        AllowAbort := False;
        try
          DelegateTransition.FOnEndTransition(Self);
        finally
          AllowAbort := True;
        end;
      end;
    end;
  end;
end;

procedure TTETransitionDevice.Finalize;
begin
  Assert(Data <> nil);
  EnterCriticalSection(CSBitmap);
  try
    FreeAndNil(Data);
  finally
    LeaveCriticalSection(CSBitmap);
  end;
  if Assigned(DelegateTransition) and FreeDelegateTransition then
    FreeAndNil(DelegateTransition);
end;

procedure TTETransitionDevice.GetOffScreenBmp(var OldPalette: hPalette);
var
  aux: TBitmap;
  TransitionInfo: TTETransitionInfo;
begin
  TransitionInfo := DelegateTransition.GetInfo(Self);
  Assert(
    not(
         (tetiNeedOffScreenBmp in TransitionInfo) and
         (not(tetiOffScreenBmpCapable in TransitionInfo))
       )
    );
  aux := nil;
  if(tetiOffScreenBmpCapable in TransitionInfo) and
    ((tetiNeedOffScreenBmp in TransitionInfo) or NeedOffScreenBmp) then
  begin
    if(Data.SrcBmp <> nil) and
      (tetiUseSrcAsOffScreenBmp in TransitionInfo)
    then aux := Data.SrcBmp
    else
    begin
      if Data.Pass = 1 then
      begin
        aux := TBitmap.Create;
        aux.Canvas.Lock;
        AdjustBmpForTransition(aux, 0,
          DelegateTransition.GetBitmapsWidth(Data), Data.Height,
          DelegateTransition.GetPixelFormat(Self));
      end;

      if Data.DstBmp <> nil
      then Data.Palette := Data.DstBmp.Palette
      else if Data.SrcBmp <> nil
      then Data.Palette := Data.SrcBmp.Palette
      else Data.Palette := 0;
      if Data.Palette <> 0
      then
      begin
        OldPalette := SelectPalette(Data.DeviceCanvas.Handle,
          Data.Palette, True);
        RealizePalette(Data.DeviceCanvas.Handle);
      end
      else OldPalette := 0;
      if HasPalette and (Data.DstBmp <> nil) then
        aux.Palette := CopyPalette(Data.DstBmp.Palette);
      if Assigned(Data.SrcBmp) and
        (
          (tetiNeedSrcBmp in TransitionInfo) or
          (not(tetiNeedOffScreenBmp in TransitionInfo))
        ) then
        BitBlt(aux.Canvas.Handle, 0, 0, Data.Width, Data.Height,
          Data.SrcBmp.Canvas.Handle, 0, 0, cmSrcCopy);
    end;
    EnterCriticalSection(CSBitmap);
    try
      if not(tetiUseSrcAsOffScreenBmp in TransitionInfo) then
      begin
        if Assigned(Data.Bitmap) and (Data.Bitmap <> Data.SrcBmp) then
        begin
          Data.Bitmap.Canvas.Unlock;
          Data.Bitmap.Free;
        end;
      end;
      Data.Bitmap := aux;
    finally
      LeaveCriticalSection(CSBitmap);
    end;
  end;
end;

procedure TTETransitionDevice.Get2ndPassBmp;
begin
  Assert(Data <> nil);
  Pass2Image := TBitmap.Create;
  Pass2Image.Canvas.Lock;
  GetSolidColorBmp(Pass2Image, TransitionToUse.GetBitmapsWidth(Data),
    Data.Height, TransitionToUse.Pass2Options.SolidColor, Data.Palette,
    Data.PixelFormat);
end;

function TTETransitionDevice.GetCurrentFrameBmp(
  var CriticalSectionEntered: Boolean): TBitmap;
begin
  Result                 := nil;
  CriticalSectionEntered := False;
  if Assigned(FTransitionThread)
  then
  begin
    CriticalSectionEntered := True;
    EnterCriticalSection(CSBitmap);
    try
      if FTransitionThread.Executing or (not FTransitionThread.Executed) then
      begin
        if Assigned(Data) and Assigned(Data.CurFrameBmp)
        then Result := Data.CurFrameBmp
        else Result := SrcImage;
      end;
    finally
      if Result = nil then
      begin
        LeaveCriticalSection(CSBitmap);
        CriticalSectionEntered := False;
      end;
    end;
  end
  else Result := SrcImage;
end;

procedure TTETransitionDevice.Initialize;
var
  RandomDirection: TTEEffectDirection;
begin
  Assert(Data = nil);

  if not Assigned(DelegateTransition) then
  begin
    // Create transition's copy
    if not TransitionIsDisabled(Transition, True)
    then
    begin
      DelegateTransition := Transition.GetDelegate(Self, True);
      DelegateTransition.FDelegatedFrom := Transition;
      if DelegateTransition.Direction = tedRandom then
      begin
        repeat
          RandomDirection :=
            TTEEffectDirection(Random(Integer(High(TTEEffectDirection))+1));
        until
          (RandomDirection in DelegateTransition.AllowedDirections) and
          (RandomDirection <> tedRandom);
        DelegateTransition.Direction := RandomDirection;
      end;
    end
    else
    begin
      DelegateTransition := TFlickerFreeTransition.Create(nil);
      DelegateTransition.Assign(Transition);
    end;
    DelegateTransition.FOnStartTransition := Transition.FOnStartTransition;
    DelegateTransition.FOnEndTransition   := Transition.FOnEndTransition;
    DelegateTransition.FOnAbortQuery      := Transition.FOnAbortQuery;
  end;

  Data := TTETransitionData.Create;
  Data.AllowDeviceUpdate := True;
  Data.Bitmap            := nil;
  Data.Device            := Self;
  Data.DeviceCanvas      := nil;
  Data.DeviceWnd         := 0;
  Data.DstBmp            := nil;
  Data.Height            := 0;
  Data.Palette           := 0;
  Data.Pass              := 1;
  Data.PassCount         := DelegateTransition.Passes(Self);
  Data.PixelFormat       := DelegateTransition.GetPixelFormat(Self);
  Data.ExternalTiming    := False;
  Data.SrcBmp            := nil;
  Data.Width             := 0;
  Data.TotalFrameIndex   := 0;
  if tetiUseDirtyRects in DelegateTransition.GetInfo(Self) then
    Data.DirtyRects := TTEDirtyRects.Create;
end;

class function TTETransitionDevice.IsThreadSafe: Boolean;
begin
  Result := False;
end;

procedure TTETransitionDevice.NextFrame(Data: TTETransitionData; InternalLoop:
  Boolean; CurrentFrame, Milliseconds, ElapsedTime: Longint;
  Chrono: TTEChrono; var Interval, LastWorkTime, StepStartTime, Step,
  SleepPrec1, SleepPrec2: Single);

  procedure GoToBed(ms, SleepPrecision: Single);
  var
    aux: Integer;
  begin
    if Assigned(FTransitionThread)
    then
    begin
      while(Data.SleepChrono.Milliseconds < ms) and (not CheckAbort(False)) do
      begin
        aux := Trunc(ms - Data.SleepChrono.Milliseconds - SleepPrecision);
        if aux > 1
        then TransitionThread.WaitEvent.WaitFor(aux)
        else TransitionThread.WaitEvent.WaitFor(1);
      end;
    end
    else
    begin
      while(Data.SleepChrono.Milliseconds < ms) and (not CheckAbort(False))
        do; {Nothing}
    end;
  end;

  procedure CalculateParameters(CurrentFrame: Longint;
    TotalMilliseconds, TransitionTime, LastStepStartTime, SleepTime: Double;
    var Interval, WorkTime, Step: Single);
  var
    FramesToEnd: Longint;
    TimeToGo: Single;
  begin
    WorkTime    := (TransitionTime - LastStepStartTime) - SleepTime;
    FramesToEnd := (Data.Frames + 1) - CurrentFrame;
    TimeToGo    := TotalMilliseconds - TransitionTime;
    if TimeToGo <= 0
    then Step := FramesToEnd
    else
    begin
      if WorkTime <> 0
      then Step := FramesToEnd / ((TotalMilliseconds - TransitionTime) / WorkTime)
      else Step := FramesToEnd /  (TotalMilliseconds - TransitionTime);
      if Step < 1 then
        Step := 1;
    end;
    Interval := (TotalMilliseconds - TransitionTime) / (FramesToEnd / Step);
  end;

var
  LastStepStartTime,
  ms,
  SleepTime: Single;
begin
  {$ifdef LogTiming}
  ms        := 0;
  {$endif LogTiming}
  SleepTime := 0;
  if InternalLoop
  then
  begin
    if Data.ExternalTiming
    then
    begin
      LastStepStartTime := StepStartTime;
      LastWorkTime      := ElapsedTime - LastStepStartTime;
      Interval          := LastWorkTime;
      if Milliseconds > ElapsedTime
      then Step         :=
             (Data.TotalFrames - Data.TotalFrameIndex) /
             ((Milliseconds - ElapsedTime) / Interval)
      else Step := Data.TotalFrames - Data.TotalFrameIndex + 1;
      StepStartTime     := ElapsedTime;
    end
    else
    begin
      ms := Interval - Data.LastUpdateTime - (Chrono.Milliseconds - StepStartTime);
      if ms > 0 then
      begin
        Data.SleepChrono.Start;
        GoToBed(ms, (SleepPrec1 + SleepPrec2) / 2);
        Data.SleepChrono.Pause;
        SleepPrec2 := SleepPrec1;
        SleepPrec1 := Data.SleepChrono.Milliseconds - ms;
        if SleepPrec1 < 0 then
          SleepPrec1 := SleepPrec2;
      end;
      SleepTime := Data.SleepChrono.Milliseconds;
      Data.SleepChrono.Reset;

      LastStepStartTime := StepStartTime;
      CalculateParameters(CurrentFrame, Milliseconds,
        Chrono.Milliseconds + ((SleepPrec1 + SleepPrec2) / 2),
        LastStepStartTime, SleepTime - ((SleepPrec1 + SleepPrec2) / 2),
        Interval, LastWorkTime, Step);
      StepStartTime := Chrono.Milliseconds;
    end;
  end
  else
  begin
    Chrono.Start;
    LastStepStartTime := StepStartTime;
    CalculateParameters(CurrentFrame, Milliseconds,
      ElapsedTime + Chrono.Milliseconds, LastStepStartTime, SleepTime, Interval,
      LastWorkTime, Step);
    StepStartTime := ElapsedTime + Chrono.Milliseconds;
    Chrono.Reset;
  end;

  {$ifdef LogTiming}
  if Assigned(DelegateTransition.Log) then
  begin
    with DelegateTransition.Log.CurrentItem^ do
    begin
      LogFrame          := Round(CurrentFrame);
      LogStep           := Step;
      LogTransitionTime := ElapsedTime;
      LogStepTime       := StepStartTime - LastStepStartTime;
      LogWorkTime       := (StepStartTime - LastStepStartTime) - SleepTime;
      LogSleepTime      := SleepTime;
      LogSleepPrecision := SleepTime - ms;
      LogInterval       := Interval;
      if DelegateTransition.Log.ChronoExtra.Milliseconds > 0 then
      begin
        LogExTime       := DelegateTransition.Log.ChronoExtra.Milliseconds;
        DelegateTransition.Log.ChronoExtra.Reset;
      end;
    end;
  end;
  {$endif LogTiming}
end;

procedure TTETransitionDevice.SetTransition(const Value: TTransitionEffect);
begin
  if Data <> nil then
    raise ETransitionEffectError.Create(rsTETransitionBusy);

  FTransition := Value;
end;

class function TTETransitionDevice.TransitionIsDisabled(
  Transition: TTransitionEffect; NoFlickerFreeWhenDisabled: Boolean): Boolean;
begin
  Result := not Transition.Enabled;
end;

function TTETransitionDevice.TransitionToUse: TTr