tevclscr.pas

delphi2007界面效果控件源码

          (
            (tetiStaticSrcPixels in TTransitionEffectHack(DelegateTransition).GetInfo(Self)) and
            Clipped
          )
        )
      then
      begin
        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);
          SrcImage.Free;
          SrcImage := RenderWindowToBmp(nil, Application.MainForm.ClientHandle,
            TCustomForm(SaveCtrl).Handle, nil, auxR, False, True, False, False,
            Data.PixelFormat);
        end
        else
        begin
          SrcImage.Free;
          SrcImage := RenderControl(
            SaveCtrl, Data.DeviceWnd,
            Rect(SaveR.Left, SaveR.Top,
              SaveR.Left + TTransitionEffectHack(DelegateTransition).GetBitmapsWidth(Data),
              SaveR.Bottom),
            UseClientCoordinates, False, False, Data.PixelFormat);
        end;
      end;
    end;
  except
    on Exception do
    begin
      UnPrepare;
      raise;
    end;
  end;
  Result := Prepared;
end;

procedure TTEVCLScreenTrDevice.Prepare2ndPass;
begin
  if TransitionToUse = nil then
    raise ETransitionEffectError.Create(rsTEDevTrIsNil);

  if not Prepared then
    Exit;

  if(SaveCtrl <> nil)                                and
    (TransitionToUse.Passes(Self) = 2)               and
    (not TransitionToUse.Pass2Options.UseSolidColor) then
    Pass2Image := RenderControl(SaveCtrl, 0,
      Rect(SaveR.Left, SaveR.Top,
        SaveR.Left + TTransitionEffectHack(TransitionToUse).GetBitmapsWidth(Data),
        SaveR.Bottom),
      UseClientCoordinates, False, False, Data.PixelFormat);
end;

class function TTEVCLScreenTrDevice.TransitionIsDisabled(
  Transition: TTransitionEffect; NoFlickerFreeWhenDisabled: Boolean): Boolean;
begin
  Result :=
    (
      NoFlickerFreeWhenDisabled or
      (not Transition.FlickerFreeWhenDisabled)
    )
    and
    (
      (inherited TransitionIsDisabled(Transition, NoFlickerFreeWhenDisabled)) or
      TEGlobalDisabled
    );
end;

procedure TTEVCLScreenTrDevice.UnPrepare;
begin
  if Prepared then
  begin
    FreeAndNil(SrcImage);
    FreeAndNil(Pass2Image);
    FreeAndNil(DstImage);
    FPrepared        := False;
    TEVclScrPrepared := False;
  end;

  Defrost;
end;

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

  Caption   := 'teRenderWindow';
  Visible   := False;
  Palette   := 0;
  Color     := clPurple;
  BkPicture := nil;
end;

procedure TTERenderWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  with Params do
  begin
    if (Parent = nil) and (ParentWindow = 0) then
    begin
      Style := WS_POPUP;

      if(Owner is TWinControl) and
        ((GetWindowLong(TWinControl(Owner).Handle, GWL_EXSTYLE) and WS_EX_TOPMOST) <> 0) then
        ExStyle := ExStyle or WS_EX_TOPMOST;

      WndParent := Application.Handle;
    end;
  end;
end;

destructor TTERenderWindow.Destroy;
begin
  BkPicture.Free;

  inherited;
end;

procedure TTERenderWindow.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  if Assigned(BkPicture) then
    BitBlt(Canvas.Handle, 0, 0, Width, Height, BkPicture.Canvas.Handle, 0, 0, cmSrcCopy);

  Message.Result := 1;
end;

function TTEVCLScreenTrDevice.AvoidScrolling: Boolean;
begin
  Result := WindowHasRegion(RenderWindow.Handle);
end;

procedure TTEVCLScreenTrDevice.GetOffScreenBmp(var OldPalette: hPalette);
begin
  OldPalette := 0;
  if(Data.SrcBmp = nil) and
    (tetiNeedSrcBmp in TTransitionEffectHack(DelegateTransition).GetInfo(Self)) then
  begin
    SrcImage := GetSnapShotImage(
      Rect(ScreenR.Left, ScreenR.Top,
        ScreenR.Left + TTransitionEffectHack(DelegateTransition).GetBitmapsWidth(Data),
        ScreenR.Bottom),
      TTransitionEffectHack(DelegateTransition).GetPixelFormat(Self), True);
    Data.SrcBmp := SrcImage;
  end;

  inherited;
end;

function TTEVCLScreenTrDevice.HasPalette: Boolean;
begin
  Result := PalettedDevice(False);
end;

procedure TTEVCLScreenTrDevice.CustomExecute;
var
  CaretWnd: HWnd;
  R,
  R2: TRect;
  SaveExStyle: Longint;
  OldPalette: hPalette;
  DirtyRender,
  UsingLayerTransition: Boolean;
  Msg: TMsg;
  Pass2Chrono: TTEChrono;
  TotalMilliseconds: Integer;
  Flags: DWord;
begin
  if not Prepared then
  begin
    Defrost;
    Exit;
  end;
  try
    if Assigned(Screen.ActiveControl)
    then
    begin
      CaretWnd := Screen.ActiveControl.Handle;
      if CaretWnd <> 0 then
        HideCaret(CaretWnd);
    end
    else CaretWnd := 0;
    try
      if ClosingForm and
        (tetiNeedDstBmp in TTransitionEffectHack(DelegateTransition).GetInfo(Self)) then
      begin
        // Check if clipped by the screen (that would cause flickering)
        GetWindowRect(RenderWindow.Handle, R);
        {$ifdef D6UP}
        R2 := Screen.DesktopRect;
        {$else}
        R2 := Bounds(Screen.DesktopLeft, Screen.DesktopTop, Screen.DesktopWidth,
                Screen.DesktopHeight);
        {$endif D6UP}
        IntersectRect(R2, R, R2);
        if not EqualRect(R, R2) then
        begin
          SetWindowPos(
            RenderWindow.Handle,
            0,
            R2.Left,
            R2.Top,
            R2.Right  - R2.Left - 1,
            R2.Bottom - R2.Top  - 1,
            SWP_NOACTIVATE or SWP_NOZORDER);
        end;
        try
          SaveExStyle := GetWindowLong(RenderWindow.Handle, GWL_EXSTYLE);
          SetWindowLong(RenderWindow.Handle, GWL_EXSTYLE, SaveExStyle or WS_EX_LAYERED);
          try
            Sleep(50); // The system needs some time to process previous sentence
            DstImage :=
              GetSnapShotImage(
                Rect(ScreenR.Left, ScreenR.Top,
                  ScreenR.Left + TTransitionEffectHack(DelegateTransition).GetBitmapsWidth(Data),
                  ScreenR.Bottom),
                TTransitionEffectHack(DelegateTransition).GetPixelFormat(Self),
                False);
          finally
            SetWindowLong(RenderWindow.Handle, GWL_EXSTYLE, SaveExStyle);
          end;
        finally
          if not EqualRect(R, R2) then
          begin
            // Recover previous bounds rect
            SetWindowPos(
              RenderWindow.Handle,
              0,
              R.Left,
              R.Top,
              R.Right  - R.Left - 1,
              R.Bottom - R.Top  - 1,
              SWP_NOACTIVATE or SWP_NOZORDER);
          end;
        end;
      end;

      if(Pass2Image = nil) and (DelegateTransition.Passes(Self) = 2) then
      begin
        if DelegateTransition.Pass2Options.SolidColor = clNone then
          DelegateTransition.Pass2Options.SolidColor := TTEWinControl(SaveCtrl).Color;
        Get2ndPassBmp;
      end;

      if Pass2Image = nil
      then
      begin
        RealizeControlPalette(SaveCtrl, False);
        if(DstImage = nil) and
          (tetiNeedDstBmp in TTransitionEffectHack(DelegateTransition).GetInfo(Self)) then
        begin
          DstImage :=
            RenderControl(
            SaveCtrl, FRenderWindow.Handle,
            Rect(
              SaveR.Left,
              SaveR.Top,
              SaveR.Left + TTransitionEffectHack(DelegateTransition).GetBitmapsWidth(Data),
              SaveR.Bottom),
            UseClientCoordinates,
            False,
            False,
            TTransitionEffectHack(DelegateTransition).GetPixelFormat(Self));
        end;

        Data.SrcBmp := SrcImage;
        Data.DstBmp := DstImage;
        GetOffScreenBmp(OldPalette);
        try
          ExePass(1, nil, DelegateTransition.Milliseconds);
        finally
          if OldPalette <> 0 then
            SelectPalette(RenderWindow.Canvas.Handle, OldPalette, True);
        end;
      end
      else
      begin
        TotalMilliseconds := DelegateTransition.Milliseconds;
        if DelegateTransition.Pass2Options.DistributedTime and
          (DelegateTransition.Milliseconds <> 0)
        then
        begin
          DelegateTransition.Milliseconds := TotalMilliseconds DIV 2;
          Pass2Chrono := TTEChrono.Create;
        end
        else Pass2Chrono := nil;

        try
          Data.SrcBmp := SrcImage;
          Data.DstBmp := Pass2Image;
          GetOffScreenBmp(OldPalette);
          try
            ExePass(1, Pass2Chrono, TotalMilliseconds);
          finally
            if OldPalette <> 0 then
              SelectPalette(RenderWindow.Canvas.Handle, OldPalette, True);
          end;

          FreeAndNil(SrcImage);

          RealizeControlPalette(SaveCtrl, False);
          if(DstImage = nil) and
            (tetiNeedDstBmp in TTransitionEffectHack(DelegateTransition).GetInfo(Self)) then
          begin
            DstImage :=
              RenderControl(
                SaveCtrl, FRenderWindow.Handle,
                Rect(
                  SaveR.Left,
                  SaveR.Top,
                  SaveR.Left + TTransitionEffectHack(DelegateTransition).GetBitmapsWidth(Data),
                  SaveR.Bottom),
                UseClientCoordinates,
                False,
                False,
                TTransitionEffectHack(DelegateTransition).GetPixelFormat(Self));
          end;

          Data.SrcBmp := Pass2Image;
          Data.DstBmp := DstImage;
          GetOffScreenBmp(OldPalette);
          try
            ExePass(2, Pass2Chrono, TotalMilliseconds);
          finally
            if OldPalette <> 0 then
              SelectPalette(RenderWindow.Canvas.Handle, OldPalette, True);
          end;
        finally
          Pass2Chrono.Free;
        end;
      end;
      if Assigned(RenderWindow) then
      begin
        DirtyRender := False;
        while PeekMessage(Msg, 0, WM_PAINT, WM_PAINT, PM_REMOVE) do
        begin
          if(not DirtyRender) and (Msg.hwnd = RenderWindow.Handle) then
            DirtyRender := True;
          DispatchMessage(Msg);
        end;
        if DirtyRender and Assigned(DstImage) then
          BitBlt(Data.DeviceCanvas.Handle, 0, 0, RenderWindow.Width,
            RenderWindow.Height, DstImage.Canvas.Handle, 0, 0, cmSrcCopy);

        Flags := SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or
          SWP_HIDEWINDOW;
        UsingLayerTransition :=
          TTransitionEffectHack(DelegateTransition).ClassNameIs('TLayeredBlendTransition');
        if(not ClosingForm) or
          UsingLayerTransition then
          Flags := Flags or SWP_NOREDRAW;
        SetWindowPos(RenderWindow.Handle, 0, 0, 0, 0, 0, Flags);
        if(SaveCtrl is TWinControl)  and
          (not ClosingForm)          and
          (not UsingLayerTransition) then
          RefreshWindows(TWinControl(SaveCtrl).Handle);
      end;
    finally
      if CaretWnd <> 0 then
        ShowCaret(CaretWnd);
    end;
  finally
    UnPrepare;
  end;
end;

function TTEVCLScreenTrDevice.GetRenderWndHandle: HWnd;
begin
  Result := RenderWindow.Handle;
end;

function TTEVCLScreenTrDevice.TwoPassesCapable: Boolean;
begin
  Result := True;
end;

function TTEVCLScreenTrDevice.GetDelegateTransition(Original: TTransitionEffect;
  const ReturnCopy: Boolean): TTransitionEffect;
begin
  if(OpeningForm or ClosingForm) and
    IsCompositionEnabled         and
    (
      ClosingForm or
      (TCustomForm(SaveCtrl).BorderStyle <> bsNone) 
    )
  then
  begin
    Result := TLayeredBlendTransition.Create(nil);
    with TLayeredBlendTransition(Result) do
    begin
      Opening  := OpeningForm;
      MaxAlpha := LayerAlpha;
      Key      := LayerKey;
      Flags    := LayerFlags;
    end;
    Result.Assign(Original);
  end
  else Result := inherited GetDelegateTransition(Original, ReturnCopy);
end;

{ TLayeredBlendTransition }

procedure TLayeredBlendTransition.Initialize(Data: TTETransitionData;
  var TotalFrames: Integer);
begin
  inherited;

  TotalFrames := MaxAlpha - 1;
end;

procedure TLayeredBlendTransition.Finalize(Data: TTETransitionData);
var
  Alpha: Byte;
begin
  if Opening
  then Alpha := MaxAlpha
  else Alpha := 0;
  teRender.SetLayeredWindowAttributes(Data.DeviceWnd, Key, Alpha, Flags or LWA_ALPHA);
  Sleep(1);

  inherited;
end;

procedure TLayeredBlendTransition.ExecuteFrame(Data: TTETransitionData;
  CurrentFrame, Step, LastExecutedFrame: Integer);
var
  Alpha: Byte;
begin
  {$ifdef LogTiming}
  if Assigned(Log) then
    Log.ChronoExtra.Start;
  {$endif LogTiming}

  if Opening
  then Alpha := CurrentFrame
  else Alpha := MaxAlpha - CurrentFrame;
  teRender.SetLayeredWindowAttributes(Data.DeviceWnd, Key, Alpha, Flags or LWA_ALPHA);
  Sleep(1);

  {$ifdef LogTiming}
  if Assigned(Log) then
  begin
    Log.ChronoExtra.Pause;
    Log.CurrentItem^.LogExTime := Log.ChronoExtra.Milliseconds;
    Log.ChronoExtra.Reset;
  end;
  {$endif LogTiming}
end;

function TLayeredBlendTransition.GetInfo(
  Device: TTETransitionDevice): TTETransitionInfo;
begin
  Result :=
    [
      tetiMillisecondsCapable
    ];
end;

initialization

  TEVclScrPrepared := False;

end.