transeff.pas

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

      Style := WS_POPUP;
      WndParent := Application.Handle;
    end;
  end;
end;
{$endif CLX}

{$ifndef CLX}

procedure TTERenderWindow.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

{$endif CLX}

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

  AllowedDirections        := [tedNone];
  FDirection               := tedNone;
  FAbortOnClick            := False;
  FAbortOnEscape           := False;
  FEnabled                 := True;
  FFlickerFreeWhenDisabled := False;
  ForceRendering           := False;
  ForceClippedMode         := False;
  NeverRendering           := False;
  FFrozen                  := False;
  FExecuting               := False;
  FPrepared                := False;
  FAborted                 := False;
  UnUpdateRect             := Rect(0, 0, 0, 0);
  UpdateRect               := Rect(0, 0, 0, 0);
  UnUpdateRectBak          := Rect(0, 0, 0, 0);
  UpdateRectBak            := Rect(0, 0, 0, 0);
  FPassSetting             := teOnePass;
  FReversed                := False;
  SecondPass               := False;
  FClientCoordinates       := True;
  AllowScreenUpdate        := True;
  FPass2Options            := TTEPass2OptionsType.Create;
  AbortChrono              := TTEChrono.Create;
  ClipRgn                  := 0;
  HasRgn                   := False;

  {$ifdef LogTiming}
  RefreshTimer := TTEChrono.Create;
  {$endif LogTiming}
  FMinAbortInterval:=300;
end;

destructor TTransitionEffect.Destroy;
begin
  if Assigned(FTransitionList) then
    FTransitionList.RemoveTransition(Self);

  AbortChrono.Free;
  {$ifdef LogTiming}
  RefreshTimer.Free;
  {$endif LogTiming}

  UnPrepare;
  FPass2Options.Free;

  inherited;
end;

class function TTransitionEffect.Description: String;
begin
  Result := ClassName;
end;

procedure TTransitionEffect.Abort;
begin
  FAborted := True;
end;

procedure TTransitionEffect.Assign(Source: TPersistent);
var
  Transition: TTransitionEffect;
begin
  if Source is TTransitionEffect
  then
  begin
    Transition              := TTransitionEffect(Source);
    Milliseconds            := Transition.Milliseconds;
    FPass2Options.Assign(Transition.Pass2Options);
    PassSetting             := Transition.PassSetting;
    ForceRendering          := Transition.ForceRendering;
    ForceClippedMode        := Transition.ForceClippedMode;
    NeverRendering          := Transition.NeverRendering;
    ClientCoordinates       := Transition.ClientCoordinates;
    Enabled                 := Transition.Enabled;
    FlickerFreeWhenDisabled := Transition.FlickerFreeWhenDisabled;
    if Transition.Direction in AllowedDirections then
      Direction             := Transition.Direction;
    Reversed                := Transition.Reversed;
    AbortOnClick            := Transition.AbortOnClick;
    AbortOnEscape           := Transition.AbortOnEscape;
  end
  else inherited;
end;

function TTransitionEffect.HasParent: Boolean;
begin
  if FTransitionList <> nil
  then Result := True
  else Result := inherited HasParent;
end;

function TTransitionEffect.GetParentComponent: TComponent;
begin
  if FTransitionList <> nil
  then Result := FTransitionList
  else Result := inherited GetParentComponent;
end;

class function TTransitionEffect.GetEditor: String;
begin
  Result := 'TTransitionEffectEditor';
end;

procedure TTransitionEffect.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TTransitionList then
    TransitionList := TTransitionList(Reader.Parent);
end;

procedure TTransitionEffect.SetParentComponent(AParent: TComponent);
begin
  if not (csLoading in ComponentState) and (AParent is TTransitionList) then
    FTransitionList := TTransitionList(AParent);
end;

function TTransitionEffect.AllowTransition: Boolean;
begin
  Result := FFlickerFreeWhenDisabled or not Disabled;
end;

procedure TTransitionEffect.SetName(const Value: TComponentName);
begin
  inherited;
  
  if Assigned(FTransitionList) and Assigned(FTransitionList.Editor) then
    FTransitionList.Editor.Perform(CM_TENAMECHANGED, Longint(Self), 0);
end;

function TTransitionEffect.DirectionToUse: TTEEffectDirection;
begin
  if ReversedToUse
  then Result := ReversedDirection
  else Result := Direction;
end;

function TTransitionEffect.ReversedDirection: TTEEffectDirection;
begin
  case Direction of
    tedRight    : Result := tedLeft;
    tedLeft     : Result := tedRight;
    tedDown     : Result := tedUp;
    tedUp       : Result := tedDown;
    tedDownRight: Result := tedUpLeft;
    tedDownLeft : Result := tedUpRight;
    tedUpRight  : Result := tedDownLeft;
    tedUpLeft   : Result := tedDownRight;
    tedIn       : Result := tedOut;
    tedOut      : Result := tedIn;
    else          Result := Direction;
  end;
end;

function TTransitionEffect.Disabled: Boolean;
begin
  Result := (not FEnabled) or TEGlobalDisabled;
end;

function TTransitionEffect.GetPixelFormat: TPixelFormat;
begin
  Result := DevicePixelFormat(False);
end;

function TTransitionEffect.GetBitmapsWidth(const DefaultWidth: Integer): Integer;
begin
  Result := DefaultWidth;
end;

function TTransitionEffect.ReversedToUse: Boolean;
begin
  Result := Reversed;
  if Pass2Options.Reversed and
    (Passes = 2)           and
    TwoPassesCapable       and
    (not SecondPass)       then
    Result := not Reversed;
end;

procedure TTransitionEffect.SetDirection(Value: TTEEffectDirection);
begin
  if Value in AllowedDirections then
    FDirection := Value;
end;

function TTransitionEffect.GetIndex: Integer;
begin
  if TransitionList <> nil
  then Result := TransitionList.FTransitions.IndexOf(Self)
  else Result := -1;
end;

procedure TTransitionEffect.SetIndex(Value: Integer);
var
  CurIndex,
  Count: Integer;
begin
  CurIndex := GetIndex;
  if CurIndex >= 0 then
  begin
    Count := TransitionList.FTransitions.Count;
    if Value < 0 then
      Value := 0;
    if Value >= Count then
      Value := Count - 1;
    if Value <> CurIndex then
    begin
      TransitionList.FTransitions.Delete(CurIndex);
      TransitionList.FTransitions.Insert(Value, Self);
    end;
  end;
end;

procedure TTransitionEffect.SetEnabled(const Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled := Value;
    if not FEnabled then
      UnPrepare;
  end;
end;

procedure TTransitionEffect.SetTransitionList(const Value: TTransitionList);
begin
  if Value <> FTransitionList then
  begin
    if FTransitionList <> nil then
      FTransitionList.RemoveTransition(Self);
    if Value <> nil then
      Value.AddTransition(Self);
  end;
end;

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

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

function TTransitionEffect.NeedDstImage: Boolean;
begin
  Result := True;
end;

function TTransitionEffect.NeedSrcImage: Boolean;
begin
  Result := True;
end;

procedure TTransitionEffect.UpdateScreen(FullUpdate: Boolean);
var
  Left,
  Top,
  Width,
  Height,
  i: Integer;
begin
  if AllowScreenUpdate and (OffScreenBmp <> nil) then
  begin
    {$ifdef LogTiming}
    RefreshTimer.Start;
    {$endif LogTiming}

    if FullUpdate
    then
    begin
      Left   := 0;
      Top    := 0;
      Width  := OffScreenBmp.Width;
      Height := OffScreenBmp.Height;
    end
    else
    begin
      if(UpdateRect.Left   = 0) and
        (UpdateRect.Top    = 0) and
        (UpdateRect.Right  = 0) and
        (UpdateRect.Bottom = 0)
      then
      begin
        Left   := 0;
        Top    := 0;
        Width  := OffScreenBmp.Width;
        Height := OffScreenBmp.Height;
      end
      else
      begin
        Left   := UpdateRect.Left;
        Top    := UpdateRect.Top;
        Width  := UpdateRect.Right  - UpdateRect.Left;
        Height := UpdateRect.Bottom - UpdateRect.Top;
      end;

      {$ifndef CLX}
      if not IsRectEmpty(UnUpdateRect) then
        ExcludeClipRect(RenderWindow.Canvas.Handle, UnUpdateRect.Left,
          UnUpdateRect.Top, UnUpdateRect.Right, UnUpdateRect.Bottom);
      {$endif CLX}
    end;

    {$ifndef CLX}
    SelectPalette(RenderWindow.Canvas.Handle, RenderWindow.Palette, True);
    if Assigned(DirtyRects) and (DirtyRects.Count > 1)
    then
    begin
      for i := 0 to DirtyRects.Count-1 do
        with DirtyRects[i] do
        begin
          BitBlt(RenderWindow.Canvas.Handle, Left, Top, Right - Left,
            Bottom - Top, OffScreenBmp.Canvas.Handle, Left, Top, cmSrcCopy);
        end;
    end
    else
    begin
      BitBlt(RenderWindow.Canvas.Handle, Left, Top, Width, Height,
        OffScreenBmp.Canvas.Handle, Left, Top, cmSrcCopy);
    end;
    {$else}
    Windows.BitBlt(QPainter_handle(RenderWindow.Canvas.Handle), Left, Top,
      Width, Height, QPainter_handle(OffScreenBmp.Canvas.Handle), Left, Top,
      SRCCOPY);
    {$endif CLX}

    {$ifndef CLX}
    if not IsRectEmpty(UnUpdateRect) then
      SelectClipRgn(RenderWindow.Canvas.Handle, 0);
    {$endif CLX}

    {$ifdef LogTiming}
    RefreshTimer.Pause;
    {$endif LogTiming}
  end;

  UnUpdateRectBak := UnUpdateRect;
  UpdateRectBak   := UpdateRect;
  UnUpdateRect    := Rect(0, 0, 0, 0);
  UpdateRect      := Rect(0, 0, 0, 0);
  if(DirtyRects <> nil) and DirtyRects.AutoClear then
    DirtyRects.Clear;
end;

function TTransitionEffect.Clipped: Boolean;
begin
  if SaveCtrl <> nil   then
     Result := ForceClippedMode or IsWindowClipped(TWinControl(SaveCtrl).Handle,
                                     TWinControl(RenderWindow).Handle,ScreenR)
  else
    Result := False;
end;

function TTransitionEffect.RenderWhenClipped: Boolean;
begin
  Result := True;
end;

function TTransitionEffect.UseOffScreenBmp: Boolean;
begin
  Result := False;
end;

function TTransitionEffect.UseSrcAsOffScreenBmp: Boolean;
begin
  Result := False;
end;

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

function TTransitionEffect.Passes: Integer;
begin
  Result := 0;
  case PassSetting of
    teOnePass:   Result := 1;
    teTwoPasses: Result := 2;
    tePaletteDependent:
      if PalettedDevice(False)
      then Result := 2
      else Result := 1;
  end;
end;

function TTransitionEffect.Freeze(Ctrl: TControl; R: TRect): Boolean;
var
  Bounds: TRect;
  ParentCtrl: TWinControl;
  Order,
  Ok: Boolean;
  VHandle: HWnd;
  Cursor: TCursor;

  procedure SetCtrlToParent;
  begin
    if Ctrl.Parent = nil then
      Exit;

    if not UseClientCoordinates
    then
    begin
      with ControlClientOffset(Ctrl) do
        OffsetRect(R, Ctrl.Left + X, Ctrl.Top + Y);
    end
    else OffsetRect(R, Ctrl.Left, Ctrl.Top);
    Ctrl := Ctrl.Parent;
    UseClientCoordinates := True;
  end;

begin
  Result := False;

  if Frozen then
    Defrost;

  if not AllowTransition then
    Exit;

  if TETransitionPrepared then
    exit;
  Cursor:=Ctrl.Cursor;              //V34
  UseClientCoordinates := ClientCoordinates;
  if not(Ctrl is TWinControl) then