transeff.pas

delphi2007界面效果控件源码

  if TransitionThread <> nil then
    TransitionThread.WaitEvent.SetEvent;
end;

function TTETransitionDevice.AllowTransition: Boolean;
begin
  Result :=
    (not TransitionIsDisabled(TransitionToUse, False)) and
    ((Data = nil) or ((Data.Width > 0) and (Data.Height > 0)));
end;

function TTETransitionDevice.CheckAbort(CheckTimer: Boolean): Boolean;
var
  Msg: TMsg;
begin
  Result :=
    Aborted or
    ((TransitionThread <> nil) and TransitionThread.Terminated);
  if not Result then
  begin
    if(TransitionThread = nil)                    and
      (
        DelegateTransition.AbortOnClick  or
        DelegateTransition.AbortOnEscape or
        Assigned(DelegateTransition.OnAbortQuery)
      )                                           then
    begin
      if(not CheckTimer) or (Assigned(Data.AbortChrono) and
        (Data.AbortChrono.Milliseconds > DelegateTransition.MinAbortInterval)) then
      begin
        if DelegateTransition.AbortOnClick and (Data.DeviceWnd <> 0) then
          Result :=
            PeekMessage(Msg, Data.DeviceWnd, WM_LBUTTONDOWN, WM_LBUTTONDOWN, PM_REMOVE);

        if(not Result) and DelegateTransition.AbortOnEscape then
          while(not Result) and
                PeekMessage(Msg, 0, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) do
            Result := Msg.wParam = VK_ESCAPE;

        if(not Result) and Assigned(DelegateTransition.OnAbortQuery) then
          DelegateTransition.OnAbortQuery(Self, DelegateTransition, Result);

        if Assigned(Data.AbortChrono) then
        begin
          Data.AbortChrono.Reset;
          Data.AbortChrono.Start;
        end;
      end;
    end;
  end;
  if Result then
    FAborted := True;
end;

constructor TTETransitionDevice.Create;
begin
  FTransition            := nil;
  FTransitionThread      := nil;
  DelegateTransition     := nil;
  Data                   := nil;
  FreeDelegateTransition := True;
  FAborted               := False;
  FExecuting             := False;
  FUsingThread           := False;
  RenderSrcFrame         := False;
  RenderDstFrame         := False;
  AllowAbort             := True;
  InitializeCriticalSection(CSThread);
  InitializeCriticalSection(CSBitmap);
end;

destructor TTETransitionDevice.Destroy;
begin
  DeleteCriticalSection(CSThread);
  DeleteCriticalSection(CSBitmap);

  if Assigned(Data) then
    Finalize;

  if Assigned(DelegateTransition) then
    FreeAndNil(DelegateTransition);

  inherited;
end;

function TTETransitionDevice.AvoidScrolling: Boolean;
begin
  Result := False;
end;

procedure TTETransitionDevice.DoCompleteExecution(Data: TTETransitionData;
  TransitionChrono: TTEChrono);
var
  CurrentFrame: Longint;
  P: TPoint;
  LastFrame: Integer;
begin
  TransitionChrono.Start;
  LastFrame := Data.PassFrames;
  if Data.FirstFrame <> -1
  then CurrentFrame := Data.FirstFrame
  else
  begin
    if Data.PassRenderSrcFrame
    then
    begin
      Dec(LastFrame);
      CurrentFrame := 0;
    end
    else CurrentFrame := 1;
  end;

  while CurrentFrame <= LastFrame do
  begin
    if CheckAbort(True) then
      break;
    Inc(Data.TotalFrameIndex);
    {$ifdef LogTiming}
    if Assigned(DelegateTransition.Log) then
      DelegateTransition.Log.NewItem;
    {$endif LogTiming}
    if Assigned(Data.DeviceCanvas)
    then
    begin
      OffsetWindowOrgEx(Data.DeviceCanvas.Handle,
        -Data.DeviceCanvasOrgOff.X, -Data.DeviceCanvasOrgOff.Y, P);
      try
        if Data.PassRenderSrcFrame and (CurrentFrame = 0)
        then BitBlt(Data.DeviceCanvas.Handle, 0, 0, Data.Width, Data.Height,
               Data.SrcBmp.Canvas.Handle, 0, 0, cmSrcCopy)
        else if Data.PassRenderDstFrame and (CurrentFrame > Data.Frames)
        then BitBlt(Data.DeviceCanvas.Handle, 0, 0, Data.Width, Data.Height,
               Data.DstBmp.Canvas.Handle, 0, 0, cmSrcCopy)
        else
        begin
          DelegateTransition.ExecuteFrame(Data, CurrentFrame, 1, CurrentFrame-1);
          UpdateDevice(TransitionChrono);
        end;
        if Data.ExternalTiming then
          GetExtTimingData(True);
      finally
        SetWindowOrgEx(Data.DeviceCanvas.Handle, P.X, P.Y, nil);
      end;
    end
    else DelegateTransition.ExecuteFrame(Data, CurrentFrame, 1, CurrentFrame-1);
    {$ifdef LogTiming}
    if Assigned(DelegateTransition.Log) then
    begin
      with DelegateTransition.Log.CurrentItem^ do
      begin
        LogFrame          := CurrentFrame;
        LogStep           := 1;
        LogTransitionTime := TransitionChrono.Milliseconds;
        LogStepTime       := LogTransitionTime - DelegateTransition.Log.LastTransitionTime;
        LogWorkTime       := LogStepTime;
        LogSleepTime      := 0;
        LogSleepPrecision := 0;
        LogInterval       := 0;
        if DelegateTransition.Log.ChronoExtra.Milliseconds > 0 then
        begin
          LogExTime       := DelegateTransition.Log.ChronoExtra.Milliseconds;
          DelegateTransition.Log.ChronoExtra.Reset;
        end;
      end;
    end;
    {$endif LogTiming}
    Inc(CurrentFrame);
  end;
  TransitionChrono.Pause;
end;

procedure TTETransitionDevice.DoTimedExecution(Data: TTETransitionData;
  TransitionChrono: TTEChrono);
var
  LastExecutedFrame,
  CurrentFrame,
  LastFrame,
  Milliseconds: Longint;
  Step,
  LastWorkTime,
  LastWorkTimeBak,
  StepStartTime,
  StepStartTimeBak,
  Interval,
  IntervalBak,
  SleepPrec1,
  SleepPrec2: Single;
  P: TPoint;
begin
  LastFrame         := Data.PassFrames;
  LastExecutedFrame := 0;
  SleepPrec1        := 0;
  SleepPrec2        := 0;

  if Data.ExternalTiming
  then
  begin
    Milliseconds  := GetExtTimingData(False);
    Interval      := Milliseconds;
    LastWorkTime  := Interval;
    StepStartTime := -Interval;
  end
  else
  begin
    Interval      := DelegateTransition.Milliseconds / (Data.PassFrames + 1);
    LastWorkTime  := Interval;
    StepStartTime := 0;
  end;

  if Data.FirstFrame <> -1
  then Step := Data.FirstFrame
  else
  begin
    if Data.PassRenderSrcFrame
    then
    begin
      Step := 0;
      Dec(LastFrame);
    end
    else
    begin
      if Data.ExternalTiming
      then
      begin
        NextFrame(Data, True, 0, DelegateTransition.Milliseconds,
          0, TransitionChrono, Interval, LastWorkTime, StepStartTime,
          Step, SleepPrec1, SleepPrec2);
      end
      else Step := 1;
    end;
  end;

  CurrentFrame := Round(Step);
  if Step = 0 then
    Step := 1;

  TransitionChrono.Start;
  while CurrentFrame <= LastFrame do
  begin
    if CheckAbort(True) then
      break;
    Inc(Data.TotalFrameIndex, Round(Step));
    {$ifdef LogTiming}
    if Assigned(DelegateTransition.Log) then
      DelegateTransition.Log.NewItem;
    {$endif LogTiming}
    if Assigned(Data.DeviceCanvas) then
    begin
      OffsetWindowOrgEx(Data.DeviceCanvas.Handle,
        -Data.DeviceCanvasOrgOff.X, -Data.DeviceCanvasOrgOff.Y, P);
      try
        if CurrentFrame = 0
        then BitBlt(Data.DeviceCanvas.Handle, 0, 0, Data.Width, Data.Height,
               Data.SrcBmp.Canvas.Handle, 0, 0, cmSrcCopy)
        else if Data.PassRenderDstFrame and (CurrentFrame > Data.Frames)
        then BitBlt(Data.DeviceCanvas.Handle, 0, 0, Data.Width, Data.Height,
               Data.DstBmp.Canvas.Handle, 0, 0, cmSrcCopy)
        else
        begin
          DelegateTransition.ExecuteFrame(
            Data,
            CurrentFrame,
            CurrentFrame - LastExecutedFrame,
            LastExecutedFrame);
          if Assigned(Data.DeviceCanvas) then
            UpdateDevice(TransitionChrono);
        end;
      finally
        SetWindowOrgEx(Data.DeviceCanvas.Handle, P.X, P.Y, nil);
      end;
    end
    else DelegateTransition.ExecuteFrame(
           Data,
           CurrentFrame,
           CurrentFrame - LastExecutedFrame,
           LastExecutedFrame);
    if Aborted then
      break;
    LastExecutedFrame := CurrentFrame;

    if Data.ExternalTiming
    then
    begin
      IntervalBak      := Interval;
      LastWorkTimeBak  := LastWorkTime;
      StepStartTimeBak := StepStartTime;
      repeat
        Milliseconds := GetExtTimingData(True);
        NextFrame(Data, True, CurrentFrame, DelegateTransition.Milliseconds,
          Milliseconds, TransitionChrono, Interval, LastWorkTime, StepStartTime,
          Step, SleepPrec1, SleepPrec2);
        if(Round(Step) = 0) and (Milliseconds < DelegateTransition.Milliseconds) then
        begin
          Interval      := IntervalBak;
          LastWorkTime  := LastWorkTimeBak;
          StepStartTime := StepStartTimeBak;
        end;
      until(Round(Step) > 0) or (Milliseconds > DelegateTransition.Milliseconds);
    end
    else
    begin
      Milliseconds := Round(TransitionChrono.Milliseconds);
      NextFrame(Data, True, CurrentFrame, DelegateTransition.Milliseconds,
        Milliseconds, TransitionChrono, Interval, LastWorkTime, StepStartTime,
        Step, SleepPrec1, SleepPrec2);
    end;

    CurrentFrame := CurrentFrame + Round(Step);
  end;
  TransitionChrono.Pause;
end;

procedure TTETransitionDevice.Execute(WaitForCompletion: Boolean = True);
begin
  if TransitionToUse = nil then
    raise ETransitionEffectError.Create(rsTEDevTrIsNil);

  if(not WaitForCompletion) and (not IsThreadSafe) then
    raise ETransitionEffectError.Create(rsTEDevNotThreadSafe);

  if(not WaitForCompletion) and
    (not(tetiThreadSafe in DelegateTransition.GetInfo(Self))) then
    raise ETransitionEffectError.Create(rsTETransNotThreadSafe);

  if Assigned(Transition.FOnBeforeTransition) then
    Transition.FOnBeforeTransition(Self);

  if WaitForCompletion
  then
  begin
    try
      if AllowTransition then
      begin
        FAborted   := False;
        FExecuting := True;
        try
          CustomExecute;
        finally
          FExecuting := False;
        end;
      end;
    finally
      if Assigned(Transition.FOnAfterTransition) then
      begin
        AllowAbort := False;
        try
          Transition.FOnAfterTransition(Self);
        finally
          AllowAbort := True;
        end;
      end;
    end;
  end
  else
  begin
    if(TransitionThread = nil) and AllowTransition
    then
    begin
      EnterCriticalSection(CSThread);
      try
        FUsingThread      := True;
        FAborted          := False;
        PostponedOnEnd    := False;
        FTransitionThread := TTETransitionThread.Create(Self);
      finally
        LeaveCriticalSection(CSThread);
      end;
    end
    else
    begin
      if Assigned(Transition.FOnAfterTransition) then
      begin
        AllowAbort := False;
        try
          Transition.FOnAfterTransition(Self);
        finally
          AllowAbort := True;
        end;
      end;
    end;
  end;
end;

procedure TTETransitionDevice.OnTransitionThreadTerminated;
begin
  try
    EnterCriticalSection(CSThread);
    try
      try
        if Assigned(TransitionThread.ExceptionRaised) then
        begin
          try
            raise TransitionThread.ExceptionRaised;
          except
            Application.HandleException(Self);
          end;
        end;
      finally
        FreeAndNil(FTransitionThread);
        FUsingThread := False;
      end;
    finally
      LeaveCriticalSection(CSThread);
    end;
  finally
    AllowAbort := False;
    try
      if Assigned(Transition.FOnEndTransition) and PostponedOnEnd then
        Transition.FOnEndTransition(Self);
      if Assigned(Transition.FOnAfterTransition) then
        Transition.FOnAfterTransition(Self);
    finally
      AllowAbort := True;
    end;
  end;
end;

procedure TTETransitionDevice.ExePass(Pass: Integer; Pass2Chrono: TTEChrono;
  TotalMilliseconds: Integer);
var
  TransitionChrono: TTEChrono;
  OutOfTime: Boolean;
  P: TPoint;
begin
  Assert((Data.Bitmap = nil) or (Data.Bitmap.Width = DelegateTransition.GetBitmapsWidth(Data)));
  Assert((Data.SrcBmp = nil) or (Data.SrcBmp.Width = DelegateTransition.GetBitmapsWidth(Data)));
  Assert((Data.DstBmp = nil) or (Data.DstBmp.Width = DelegateTransition.GetBitmapsWidth(Data)));

  Data.Pass := Pass;
  if DelegateTransition.Pass2Options.Reversed and (Data.PassCount = 2) then
    DelegateTransition.Reversed := not DelegateTransition.Reversed;

  if Assigned(DelegateTransition.FOnStartTransition) and (Pass=1) then
  begin
    if (TransitionThread <> nil) then
      EnterCriticalSection(TransitionThread.CSSync);
    try
      if not Aborted then
      begin