transeff.pas

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

                    try
                      DoExecute(Data);
                    finally
                      AbortChrono.Reset;
                    end;

                    if Assigned(OnEndTransition) then
                      OnEndTransition(Self);
                  finally
                    Data.Free;
                  end;
                  {$ifndef CLX}
                  if OldPalette <> 0 then
                    SelectPalette(RenderWindow.Canvas.Handle, OldPalette, True);
                  {$endif CLX}
                end
                else
                begin
                  SaveMilliseconds := Milliseconds;
                  if Pass2Options.DistributedTime then
                    Milliseconds := Milliseconds DIV 2;
                  GetOffScreenBmp;
                  Data := TTETransitionData.Create(RenderWindow.Width,
                    RenderWindow.Height, OldImage, BackGroundImage,
                    OffScreenBitmap, ScreenCanvas, GetPixelFormat,True);
                  try
                    {$ifndef CLX}
                    Palette := BackgroundImage.Palette;
                    if Palette <> 0  then
                    begin
                      OldPalette := SelectPalette(RenderWindow.Canvas.Handle,
                        Palette, True);
                      RenderWindow.Palette := Palette;
                      RealizePalette(RenderWindow.Canvas.Handle);
                    end
                    else OldPalette := 0;
                    {$endif CLX}
                    if TwoPassesCapable then
                    begin
                      if Assigned(OnStartTransition) then
                        OnStartTransition(Self);

                      AbortChrono.Start;
                      try
                        DoExecute(Data);
                      finally
                        AbortChrono.Reset;
                      end;
                    end
                    else
                      {$ifndef CLX}
                      SelectPalette(RenderWindow.Canvas.Handle,
                        RenderWindow.Palette, True);
                      BitBlt(Data.Canvas.Handle, 0, 0, Data.Width, Data.Height,
                        Data.DstBmp.Canvas.Handle, 0, 0, cmSrcCopy);
                      {$else}
                      Windows.BitBlt(QPainter_handle(Data.Canvas.Handle), 0, 0,
                        Data.Width, Data.Height,
                        QPainter_handle(Data.DstBmp.Canvas.Handle), 0, 0,
                        SRCCOPY);
                      {$endif CLX}

                    {$ifndef CLX}
                    if OldPalette <> 0 then
                      SelectPalette(RenderWindow.Canvas.Handle, OldPalette, True);
                    {$endif CLX}
                  finally
                    Data.Free;
                  end;

                  OldImage.Free;
                  OldImage   := nil;
                  SecondPass := True;

                  RealizeControlPalette(SaveCtrl, False);
                  if NeedDstImage then
                    NewImage := RenderControl(SaveCtrl,
                      Rect(SaveR.Left, SaveR.Top,
                        SaveR.Left + GetBitmapsWidth(SaveR.Right - SaveR.Left),
                        SaveR.Bottom),
                      UseClientCoordinates, False, GetPixelFormat);
                  //-------------------------------------------------
                  if OffScreenBitmapCreated then
                  begin
                    if PalettedDevice(False) then
                    begin
                      OffScreenBitmap.PixelFormat := pf8bit;
                      {$ifndef CLX}
                      if NewImage <> nil
                      then OffScreenBitmap.Palette :=
                             CopyPalette(NewImage.Palette)
                      else OffScreenBitmap.Palette :=
                             CopyPalette(BackGroundImage.Palette);
                      {$endif CLX}
                    end;
                  end   //PalettedDevice(False)
                  else
                    if UseOffScreenBmp then
                      OffScreenBitmap := BackGroundImage;
                  //-------------------------------------------------

                  Data := TTETransitionData.Create(RenderWindow.Width,
                    RenderWindow.Height, BackGroundImage, NewImage,
                    OffScreenBitmap, ScreenCanvas, GetPixelFormat,True);
                  try
                   {$ifndef CLX}
                    if NewImage <> nil then
                      BackgroundImage.Palette := CopyPalette(NewImage.Palette);
                    Palette := BackgroundImage.Palette;
                    if Palette <> 0 then
                    begin
                      OldPalette := SelectPalette(RenderWindow.Canvas.Handle,
                        Palette, True);
                      RenderWindow.Palette := Palette;
                      RealizePalette(RenderWindow.Canvas.Handle);
                    end
                    else OldPalette := 0;
                    {$endif CLX}
                    if Assigned(OnStartTransition) and (not TwoPassesCapable) then
                      OnStartTransition(Self);
                    AbortChrono.Start;
                    try
                      DoExecute(Data);
                    finally
                      AbortChrono.Reset;
                    end;
                    if Assigned(OnEndTransition) then
                      OnEndTransition(Self);
                    {$ifndef CLX}
                    if OldPalette <> 0 then
                      SelectPalette(RenderWindow.Canvas.Handle, OldPalette, True);
                    {$endif CLX}
                  finally
                    Data.Free;
                  end;

                  if Pass2Options.DistributedTime then
                    Milliseconds := SaveMilliseconds;
                end; //Else (BackGroundImage = nil)
              finally
                if OffScreenBitmapCreated then
                  OffScreenBitmap.Free;
              end;
              End;
              DirtyRender:=False; //V33
              while  PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE)  do
              Begin
                If Not DirtyRender And (RenderWindow.Handle= Msg.hwnd) Then  //V33
                   DirtyRender:=True;
                DispatchMessage(Msg);
              End;
              If DirtyRender Then //V33
                BitBlt(RenderWindow.Canvas.Handle, 0, 0, RenderWindow.Width, RenderWindow.Height,
                  NewImage.Canvas.Handle, 0, 0, cmSrcCopy);
            {$ifndef CLX}
            SetWindowPos(RenderWindow.Handle, 0, 0, 0, 0, 0,
              SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or
              SWP_HIDEWINDOW or SWP_NOREDRAW);
            {$else}
            {$ifdef MSWINDOWS}
            SetWindowPos(QWidget_winId(RenderWindow.Handle), 0, 0, 0, 0, 0,
              SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or
              SWP_HIDEWINDOW or SWP_NOREDRAW);
            {$endif MSWINDOWS}
            {$endif CLX}
            if SaveCtrl is TWinControl then
              RefreshWindows(TWinControl(SaveCtrl).Handle);
          end; //V33
        finally
          FExecuting := False;
          SecondPass := False;
          UnPrepare;
        end;
      finally
        {$ifndef CLX}
        if CaretWnd <> 0 then
          ShowCaret(CaretWnd);
        {$endif CLX}
      end;
    end;
  finally
    if Assigned(OnAfterTransition) then
      OnAfterTransition(Self);
  end;
end;

procedure TTransitionEffect.CheckAbort(CheckTimer: Boolean);
{$ifndef CLX}
var
  Msg: TMsg;
{$endif CLX}
begin
  if Aborted then
    exit;
  {$ifndef CLX}
  if AbortOnClick or AbortOnEscape or Assigned(FOnAbortQuery) then
  begin
    if (AbortChrono.Milliseconds > FMinAbortInterval) Or (Not CheckTimer){V33} then
    begin
      if AbortOnClick then
        FAborted := PeekMessage(Msg, RenderWindow.Handle, WM_LBUTTONDOWN,
          WM_LBUTTONDOWN, PM_REMOVE);

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

      if(not Aborted) and Assigned(FOnAbortQuery) then
        OnAbortQuery(Self, Self, FAborted);

      AbortChrono.Reset;
      AbortChrono.Start;
    end;
  end;
  {$endif CLX}
end;

{ TTransitionList }

constructor TTransitionList.Create(AOwner: TComponent);
begin
  inherited;

  Editor       := nil;
  FTransitions := TList.Create;
end;

destructor TTransitionList.Destroy;
var
  i: Integer;
begin
  if Assigned(FTransitions) then
    For I:=0 To FTransitions.Count-1 Do
       TTransitionEffect(FTransitions[i]).Free;
  FTransitions.Free;
  inherited;
end;

procedure TTransitionList.AddTransition(Transition: TTransitionEffect);
begin
  FTransitions.Add(Transition);
  Transition.FTransitionList := Self;
end;

procedure TTransitionList.RemoveTransition(Transition: TTransitionEffect);
begin
  if FTransitions.Remove(Transition) >= 0 then
    Transition.FTransitionList := nil;
end;

function TTransitionList.GetTransitionCount: Integer;
begin
  if FTransitions = nil
  then Result := 0
  else Result := FTransitions.Count;
end;

function TTransitionList.GetTransition(Index: Integer): TTransitionEffect;
begin
  Result := FTransitions[Index];
end;

procedure TTransitionList.SetTransition(Index: Integer;
  const Value: TTransitionEffect);
begin
  Transitions[Index].Free;
  AddTransition(Value);
  Value.Index := Index;
end;

procedure TTransitionList.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if(Operation = opRemove)            and
    (AComponent is TTransitionEffect) then
    RemoveTransition(TTransitionEffect(AComponent));
end;

function TTransitionList.GetVersion: String;
begin
  Result := BilleniumEffectsVersion;
end;

procedure TTransitionList.SetVersion(const Value: String);
begin
end;

procedure TTransitionList.GetChildren(Proc: TGetChildProc;
  Root: TComponent);
var
  I: Integer;
  Transition: TTransitionEffect;
begin
  for I := 0 to FTransitions.Count - 1 do
  begin
    Transition := FTransitions[I];
    if Transition.Owner = Root then
      Proc(Transition);
  end;
end;

{ TFCDirtyRects }

procedure TFCDirtyRects.AddRect(R: TRect);
var
  P: PRect;
begin
  if CheckBounds then
  begin
    IntersectRect(R, R, Bounds);
    if IsRectEmpty(R) then
      exit;
  end;

  GetMem(P, SizeOf(TRect));
  P^ := R;
  FRects.Add(P);
end;

constructor TFCDirtyRects.Create;
begin
  FRects := TList.Create;

  CheckBounds := False;
  AutoClear   := True;
end;

destructor TFCDirtyRects.Destroy;
var
  i: Integer;
begin
  for i := 0 to Count-1 do
    FreeMem(FRects[i], SizeOf(TRect));

  FRects.Free;

  inherited;
end;

procedure TFCDirtyRects.Clear;
var
  i: Integer;
begin
  for i := 0 to Count-1 do
    FreeMem(FRects[i], SizeOf(TRect));
  FRects.Clear;
end;

function TFCDirtyRects.GetRect(Index: Integer): TRect;
begin
  Result := TRect(FRects[Index]^);
end;

function TFCDirtyRects.GetRectCount: Integer;
begin
  Result := FRects.Count;
end;

procedure TFCDirtyRects.RemoveRect(Index: Integer);
begin
  FreeMem(FRects[Index], SizeOf(TRect));
  FRects.Delete(Index);
end;

procedure TFCDirtyRects.SetRect(Index: Integer; const Value: TRect);
begin
  TRect(FRects[Index]^) := Value;
end;

{ TTETransitionData }
constructor TTETransitionData.Create(WidthValue, HeightValue: Integer;
  SrcBmpValue, DstBmpValue: TBitmap; BitmapValue: TBitmap;
  ScreenCanvasValue: TCanvas; PixelFormatValue: TPixelFormat; RealTime: Boolean);

begin
  FSrcBmp       := SrcBmpValue;
  FDstBmp       := DstBmpValue;
  FBitmap       := BitmapValue;
  FScreenCanvas := ScreenCanvasValue;
  FHeight       := HeightValue;
  FWidth        := WidthValue;
  FPixelFormat  := PixelFormatValue;
  FIsRGB        := RGBDevice(False);
  FRealTime     := RealTime;
end;

function TTETransitionData.GetCanvas: TCanvas;
begin
  if Bitmap <> nil
  then Result := Bitmap.Canvas
  else Result := FScreenCanvas;
end;

{ TFlickerFreeTransition }
class function TFlickerFreeTransition.Description: String;
begin
  Result := 'Flicker free cut';
end;

function TFlickerFreeTransition.NeedSrcImage: Boolean;
begin
  Result := False;
end;

{$ifndef CLX}
function TFlickerFreeTransition.GetPixelFormat: TPixelFormat;
begin
  Result := pfDevice;
end;
{$endif CLX}

procedure TFlickerFreeTransition.DoExecute(Data: TTETransitionData);
begin
  {$ifndef CLX}
  BitBlt(Data.Canvas.Handle, 0, 0, Data.Width, Data.Height,
    Data.DstBmp.Canvas.Handle, 0, 0, cmSrcCopy);
  {$else}
  Windows.BitBlt(QPainter_handle(Data.Canvas.Handle), 0, 0, Data.Width,
    Data.Height, QPainter_handle(Data.DstBmp.Canvas.Handle), 0, 0, SRCCOPY);
  {$endif CLX}
end;

initialization

  TERegisterTransition(TFlickerFreeTransition);

  FlickerFreeTransition := TFlickerFreeTransition.Create(nil);
  FlickerFreeTransition.FlickerFreeWhenDisabled := True;

  TEGlobalDisabled     := False;
  OldTransition        := nil;
  NewTransition        := nil;
  TETransitionPrepared := False;

finalization

  TERegisteredTransitions.Free;
  FlickerFreeTransition.Free;

end.