transeff.pas

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

    SetCtrlToParent;
  Ok := True;
  repeat
    if not Ok then
      SetCtrlToParent;

    {$ifndef CLX}
    if Ctrl.Parent is TPageControl then
      SetCtrlToParent;
    {$endif CLX}

    if(Ctrl is TForm) and (TForm(Ctrl).FormStyle = fsMDIChild)
    then VHandle := Application.MainForm.Handle
    else VHandle := TWinControl(Ctrl).Handle;

    {$ifndef CLX}
    Ok := IsWindowVisible(VHandle);
    {$else}
    Ok := QWidget_isVisible(VHandle);
    {$endif CLX}
  until Ok or (Ctrl.Parent = nil);

  if not Ok then
    Exit;

  if not UseClientCoordinates then
  begin
    with ControlClientOffset(Ctrl) do
    begin
      if(X <= R.Left) and
        (Y <= R.Top ) and
        ((R.Right  - X) <= ControlClientWidth (Ctrl)) and
        ((R.Bottom - Y) <= ControlClientHeight(Ctrl)) then
      begin
        UseClientCoordinates := True;
        OffsetRect(R, -X, -Y);
      end;
    end;
  end;

  if  (Not UseClientCoordinates) And (Ctrl is TForm) and Not (TForm(Ctrl).FormStyle = fsMDIChild) And
      (Ctrl.Parent = nil) Then
        ScreenR:=R
      Else
      Begin
        ScreenR.TopLeft     := ControlClientToScreen(Ctrl, R.TopLeft);
        ScreenR.BottomRight := ControlClientToScreen(Ctrl, R.BottomRight);

        if not UseClientCoordinates then
        begin
          with ControlClientOffset(Ctrl) do
            OffsetRect(ScreenR, -X, -Y);
        end;
      End;

  Ctrl.Update;
//  Application.ProcessMessages; // This messes up events

  Order := False;
  if UseClientCoordinates
  then ParentCtrl := TWinControl(Ctrl)
  else
  begin
    if Ctrl.Parent <> nil
    then
    begin
      ParentCtrl := Ctrl.Parent;
      Order      := True
    end
    else ParentCtrl := nil;
  end;

  if ParentCtrl = nil
  then Bounds := ScreenR  else
  begin
    Bounds.TopLeft     := ControlScreenToClient(ParentCtrl, ScreenR.TopLeft);
    Bounds.BottomRight := ControlScreenToClient(ParentCtrl, ScreenR.BottomRight);
  end;

  SaveCtrl := Ctrl;
  SaveR.TopLeft     := ControlScreenToClient(SaveCtrl, ScreenR.TopLeft);
  SaveR.BottomRight := ControlScreenToClient(SaveCtrl, ScreenR.BottomRight);
  if not UseClientCoordinates then
  begin
    with ControlClientOffset(SaveCtrl) do
      OffsetRect(SaveR, X, Y);
  end;

  try
    RenderWindow := TTERenderWindow.Create(Ctrl);
    RenderWindow.Cursor :=Cursor; //V34

    if ParentCtrl <> nil
    then
    begin
      RenderWindow.Parent := ParentCtrl;
      SaveStyle := GetWindowLong(ParentCtrl.Handle, GWL_STYLE);
      if(SaveStyle and WS_CLIPCHILDREN) = 0
      then SetWindowLong(ParentCtrl.Handle, GWL_STYLE,
             SaveStyle or WS_CLIPCHILDREN)
      else SaveStyle := 0;
    end
    else SaveStyle := 0;

    if Order then
      SetChildOrderAfter(RenderWindow, Ctrl);
    RenderWindow.BoundsRect := Bounds;

    {$ifndef CLX}
    ShowWindow(RenderWindow.Handle, SW_SHOWNA);

    if ParentCtrl = nil then
      SetWindowPos(RenderWindow.Handle,
        GetWindow(TWinControl(Ctrl).Handle, GW_HWNDPREV), 0, 0, 0, 0,
        SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
     ValidateRect(TWinControl(RenderWindow).Handle, nil);  //V33
    {$else}
    {$ifdef MSWINDOWS}
    ShowWindow(QWidget_winId(RenderWindow.Handle), SW_SHOWNA);

    if ParentCtrl = nil then
      SetWindowPos(QWidget_winId(RenderWindow.Handle),
        GetWindow(QWidget_winId(TWinControl(Ctrl).Handle), GW_HWNDPREV),
        0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
     ValidateRect(TWinControl(RenderWindow).Handle, nil); //V33
    {$endif MSWINDOWS}
    {$endif CLX}

    FFrozen := True;
  except
    on Exception do
    begin
      Defrost;
      raise;
    end;
  end;
  Result := FFrozen;
end;

function TTransitionEffect.Prepare(Ctrl: TControl; R: TRect): Boolean;
var
  auxR: TRect;
begin
  Result := False;

  if Prepared then
    UnPrepare;

  if not Freeze(Ctrl, R) then
    exit;

  FPrepared            := True;
  TETransitionPrepared := True;

  try
    if(not Disabled) and NeedSrcImage
    then
    begin
      if(not NeverRendering) and
        (ForceRendering or (RenderWhenClipped and Clipped))
      then
      begin
        {$ifndef CLX}
        if(SaveCtrl is TForm) and
          (TForm(SaveCtrl).FormStyle = fsMDIChild)
        then
        begin
          auxR := ScreenR;
          ScreenToClient(Application.MainForm.ClientHandle, auxR.TopLeft);
          ScreenToClient(Application.MainForm.ClientHandle, auxR.BottomRight);
          OldImage := RenderWindowToBmp(Application.MainForm.ClientHandle,
            TCustomForm(SaveCtrl).Handle, nil, auxR, False, False,
            GetPixelFormat)
        end
        else
          OldImage := RenderControl(SaveCtrl,
            Rect(SaveR.Left, SaveR.Top,
            SaveR.Left + GetBitmapsWidth(SaveR.Right - SaveR.Left),
            SaveR.Bottom), UseClientCoordinates, False, GetPixelFormat);
        {$endif CLX}
      end
      else
        if(GetPixelFormat <> pf8bit) or (Passes = 2) then
          OldImage := GetSnapShotImage(
            Rect(ScreenR.Left, ScreenR.Top,
            ScreenR.Left + GetBitmapsWidth(ScreenR.Right - ScreenR.Left),
            ScreenR.Bottom), GetPixelFormat);
    end;
  except
    on Exception do
    begin
      UnPrepare;
      raise;
    end;
  end;
  Result := Prepared;
end;

procedure TTransitionEffect.Prepare2ndPass;
var
  Palette: HPALETTE;
begin
  if Disabled then
    Exit;

  if not Prepared then
    Exit;

  if(SaveCtrl <> nil) and (Passes = 2) then
  begin
    if Pass2Options.UseSolidColor
    then
    begin
      {$ifndef CLX}
      if OldImage <> nil
      then Palette := CopyPalette(OldImage.Palette)
      else Palette := 0;
      {$else}
      Palette := 0;
      {$endif CLX}
      BackGroundImage := GetSolidColorImage(SaveCtrl,
        GetBitmapsWidth(SaveR.Right - SaveR.Left),
        SaveR.Bottom-SaveR.Top, Pass2Options.SolidColor, Palette, GetPixelFormat);
    end
    else
      BackGroundImage := RenderControl(SaveCtrl,
        Rect(SaveR.Left, SaveR.Top,
          SaveR.Left + GetBitmapsWidth(SaveR.Right - SaveR.Left), SaveR.Bottom),
        UseClientCoordinates, False, GetPixelFormat);
  end;
end;

procedure TTransitionEffect.Defrost;
var
  ParentWindow: TWinControl;
begin
  if RenderWindow <> nil then
  begin
    if ClipRgn<> 0 then
    begin
      DeleteObject(ClipRgn);
      ClipRgn := 0;
    end;

    ParentWindow := RenderWindow.Parent;
    // This avoids flickering under some circumstances
    if ParentWindow <> nil then
      ParentWindow.DisableAlign;

    if SaveStyle <> 0 then
    begin
      SetWindowLong(ParentWindow.Handle, GWL_STYLE, SaveStyle);
      SaveStyle := 0;
    end;

    RenderWindow.Free;
    if ParentWindow <> nil then
    begin
      ParentWindow.ControlState := ParentWindow.ControlState - [csAlignmentNeeded];
      ParentWindow.EnableAlign;
    end;
    RenderWindow := nil;
  end;
  FFrozen  := False;
  SaveCtrl := nil;
end;

procedure TTransitionEffect.UnPrepare;
begin
  if Prepared then
  begin
    OldImage.Free;
    OldImage := nil;

    BackGroundImage.Free;
    BackGroundImage := nil;

    NewImage.Free;
    NewImage := nil;

    FPrepared            := False;
    TETransitionPrepared := False;
  end;

  Defrost;
end;

procedure TTransitionEffect.Execute;
var
  Data: TTETransitionData;
  OffScreenBitmap: TBitmap;
  DirtyRender: Boolean;
  OffScreenBitmapCreated: Boolean;
  SaveMilliseconds: Longint;
  ScreenCanvas: TCanvas;
  Msg: TMsg;
  {$ifndef CLX}
  CaretWnd: HWnd;
  Palette,
  OldPalette: hPalette;
  {$endif CLX}

  procedure GetOffScreenBmp;
  begin
    if(OldImage = nil) and NeedSrcImage then
      OldImage := GetSnapShotImage(
        Rect(ScreenR.Left, ScreenR.Top,
        ScreenR.Left + GetBitmapsWidth(ScreenR.Right - ScreenR.Left),
        ScreenR.Bottom), GetPixelFormat);

    if UseOffScreenBmp then
    begin
      if NeedSrcImage and UseSrcAsOffScreenBmp
      then OffScreenBitmap := OldImage
      else
      begin
        OffScreenBitmap        := TBitmap.Create;
        OffScreenBitmapCreated := True;
      end;
    end;
    if OffScreenBitmapCreated then
      AdjustBmpForTransition(OffScreenBitmap,
        {$ifndef CLX}0,{$endif CLX}
        GetBitmapsWidth(SaveR.Right - SaveR.Left),
        RenderWindow.Height, GetPixelFormat);
  end;

begin
  HasRgn := ClipRgn <> 0; // this has to be done before UseOffScreenBmp is called
  if HasRgn then
  begin
    SetWindowRgn(RenderWindow.Handle, ClipRgn, False);
    ClipRgn := 0;
  end;

  if Assigned(OnBeforeTransition) then
    OnBeforeTransition(Self);
  try
    if AllowTransition
    then
    begin
      if not Prepared then
      begin
        Defrost;
        Exit;
      end;

      FAborted               := False;
      FExecuting             := True;
      SecondPass             := False;
      OffScreenBitmap        := nil;
      OffScreenBitmapCreated := False;
      ScreenCanvas           := RenderWindow.Canvas;
      UnUpdateRect           := Rect(0, 0, 0, 0);
      UpdateRect             := Rect(0, 0, 0, 0);

      {$ifndef CLX}
      if Assigned(Screen.ActiveControl)
      then
      begin
        CaretWnd := Screen.ActiveControl.Handle;
        if CaretWnd <> 0 then
          HideCaret(CaretWnd);
      end
      else CaretWnd := 0;
      {$endif CLX}

      try  //EROC itnA
        try
          if(RenderWindow.Parent = nil) or
            {$ifndef CLX}
            IsWindowVisible(RenderWindow.Handle)
            {$else}
            QWidget_isVisible(RenderWindow.Handle)
            {$endif CLX}  Then
          begin
            if Disabled then
            begin
              RealizeControlPalette(SaveCtrl, False);
              NewImage := RenderControl(SaveCtrl,
                Rect(SaveR.Left, SaveR.Top,
                  SaveR.Left + GetBitmapsWidth(SaveR.Right - SaveR.Left), SaveR.Bottom),
                UseClientCoordinates, False, GetPixelFormat);
              {$ifndef CLX}
              Palette := NewImage.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}

              {$ifndef CLX}
              BitBlt(RenderWindow.Canvas.Handle, 0, 0, RenderWindow.Width,
                RenderWindow.Height, NewImage.Canvas.Handle, 0, 0, cmSrcCopy);
              if OldPalette <> 0 then
                SelectPalette(RenderWindow.Canvas.Handle, OldPalette, True);
              {$else}
              Windows.BitBlt(QPainter_handle(RenderWindow.Canvas.Handle), 0, 0,
                RenderWindow.Width, RenderWindow.Height,
                QPainter_handle(NewImage.Canvas.Handle), 0, 0, SRCCOPY);
              {$endif CLX}
            end //if Disabled then
            else
            begin
              if(BackGroundImage = nil) and (Passes = 2) then
                Prepare2ndPass;
              try
                if BackGroundImage = nil then
                begin
                  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);

                  {$ifndef CLX}
                  if NewImage <> nil
                  then Palette := NewImage.Palette
                  else Palette := OldImage.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}

                  GetOffScreenBmp;
                  {$ifndef CLX}
                  if OffScreenBitmapCreated and PalettedDevice(False) and (NewImage <> nil) then
                    OffScreenBitmap.Palette := CopyPalette(NewImage.Palette);
                  {$endif CLX}

                  Data := TTETransitionData.Create(RenderWindow.Width, RenderWindow.Height,
                    OldImage, NewImage, OffScreenBitmap, ScreenCanvas, GetPixelFormat,True);

                  try
                    if Assigned(OnStartTransition) then
                      OnStartTransition(Self);

                    AbortChrono.Start;