teslide.pas

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

unit teSlide;

interface

{$INCLUDE teDefs.inc}

uses
  SysUtils, Classes, TransEff, teTimed,
  {$ifdef CLX}
  QForms, QGraphics;
  {$else}
  Windows, Messages, Forms, Graphics;
  {$endif CLX}

type
  TSlideTransition = class(TTimedTransitionEffect)
  private
    FElasticSrc,
    FElasticDst: Boolean;
    FSlideOut: Boolean;
    SaveStretchBltMode: Integer;
  protected
    Mode: Integer;
    ClipR,
    VisibleR: TRect;
    DstXDesp,
    DstYDesp: Integer;
    IsClipped: Boolean;

    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    procedure Finalize(Data: TTETransitionData); override;
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint); override;

    function  GetPixelFormat: TPixelFormat; override;
    function  NeedSrcImage: Boolean; override;
    function  ElasticSrcToUse: Boolean;
    function  ElasticDstToUse: Boolean;
    function  SlideOutToUse: Boolean;
  public
    constructor Create(AOwner: TComponent{$ifdef DP} = nil{$endif}); override;
    class function Description: String; override;

    procedure Assign(Source: TPersistent); override;
    class function GetEditor: String; override;
  published
    property Direction default tedDown;
    property ElasticDst: Boolean read FElasticDst write FElasticDst default False;
    property ElasticSrc: Boolean read FElasticSrc write FElasticSrc default False;
    property Reversed;
    property SlideOut: Boolean read FSlideOut write FSlideOut default False;
  end;

implementation

uses teRender;

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

  AllowedDirections := [tedRight, tedLeft, tedDown, tedUp, tedDownRight,
    tedDownLeft, tedUpRight, tedUpLeft, tedIn, tedOut];
  Direction   := tedDown;
  FElasticSrc := False;
  FElasticDst := False;
  FSlideOut   := False;
end;

class function TSlideTransition.Description: String;
begin
  Result := 'Slide';
end;

procedure TSlideTransition.Assign(Source: TPersistent);
var
  Transition: TSlideTransition;
begin
  if Source is TSlideTransition
  then
  begin
    inherited;

    Transition := TSlideTransition(Source);
    ElasticSrc := Transition.ElasticSrc;
    ElasticDst := Transition.ElasticDst;
    SlideOut   := Transition.SlideOut;
  end
  else inherited;
end;

class function TSlideTransition.GetEditor: String;
begin
  Result := 'TSlideTransitionEditor';
end;

function TSlideTransition.ElasticDstToUse: Boolean;
begin
  if ReversedToUse
  then Result := ElasticSrc
  else Result := ElasticDst;
end;

function TSlideTransition.ElasticSrcToUse: Boolean;
begin
  if ReversedToUse
  then Result := ElasticDst
  else Result := ElasticSrc;
end;

function TSlideTransition.SlideOutToUse: Boolean;
begin
  Result := SlideOut;
  if ReversedToUse then
    Result := not Result;
end;

function TSlideTransition.GetPixelFormat: TPixelFormat;
begin
  // Timing doesn't work fine with ScrollDC and DDBs
  Result := DevicePixelFormat(False);
end;

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

procedure TSlideTransition.Initialize(Data: TTETransitionData; var Frames: Longint);

  function GetMode: Integer;
  begin
    case DirectionToUse of
      tedRight    : if SlideOutToUse
                    then if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 16
                              else Result := 37
                         else if ElasticSrcToUse
                              then Result := 36
                              else Result := 35
                    else if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 16
                              else Result := 15
                         else if ElasticSrcToUse
                              then Result := 14
                              else Result := 13;
      tedLeft     : if SlideOutToUse
                    then if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 12
                              else Result := 34
                         else if ElasticSrcToUse
                              then Result := 33
                              else Result := 32
                    else if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 12
                              else Result := 11
                         else if ElasticSrcToUse
                              then Result := 10
                              else Result :=  9;
      tedDown     : if SlideOutToUse
                    then if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result :=  4
                              else Result := 28
                         else if ElasticSrcToUse
                              then Result := 27
                              else Result := 26
                    else if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result :=  4
                              else Result :=  3
                         else if ElasticSrcToUse
                              then Result :=  2
                              else Result :=  1;
      tedUp       : if SlideOutToUse
                    then if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result :=  8
                              else Result := 31
                         else if ElasticSrcToUse
                              then Result := 30
                              else Result := 29
                    else if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result :=  8
                              else Result :=  7
                         else if ElasticSrcToUse
                              then Result :=  6
                              else Result :=  5;
      tedDownRight: if SlideOutToUse
                    then if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 20
                              else Result := 20
                         else if ElasticSrcToUse
                              then Result := 41
                              else Result := 40
                    else if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 20
                              else Result := 20
                         else if ElasticSrcToUse
                              then Result := 41
                              else Result := 19;
      tedDownLeft : if SlideOutToUse
                    then if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 18
                              else Result := 18
                         else if ElasticSrcToUse
                              then Result := 39
                              else Result := 38
                    else if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 18
                              else Result := 18
                         else if ElasticSrcToUse
                              then Result := 39
                              else Result := 17;
      tedUpRight  : if SlideOutToUse
                    then if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 24
                              else Result := 24
                         else if ElasticSrcToUse
                              then Result := 45
                              else Result := 44
                    else if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 24
                              else Result := 24
                         else if ElasticSrcToUse
                              then Result := 45
                              else Result := 23;
      tedUpLeft   : if SlideOutToUse
                    then if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 22
                              else Result := 22
                         else if ElasticSrcToUse
                              then Result := 43
                              else Result := 42
                    else if ElasticDstToUse
                         then if ElasticSrcToUse
                              then Result := 22
                              else Result := 22
                         else if ElasticSrcToUse
                              then Result := 43
                              else Result := 21;
      tedIn       : Result := 46;
      tedOut      : Result := 25;
      else          Result :=  0;
    end;
  end;

begin
  inherited;

  Mode      := GetMode;
  ClipR     := Rect(0, 0, Data.Width, Data.Height);
  IsClipped := Clipped;

  SaveStretchBltMode := SetStretchBltMode(Data.Canvas.Handle, COLORONCOLOR);

  case Mode of
     1,
     2,
     3,
     4: begin
          Frames   := Data.Height;
          DstYDesp := Data.Height;
          VisibleR := Rect(0, 0, Data.Width, 0);
        end;
     5,
     6,
     7,
     8: begin
          Frames   := Data.Height;
          DstYDesp := 0;
          VisibleR := Rect(0, Data.Height, Data.Width, Data.Height);
        end;
     9,
    10,
    11,
    12: begin
          Frames   := Data.Width;
          DstXDesp := -1;
          VisibleR := Rect(Data.Width, 0, Data.Width, Data.Height);
        end;
    13,
    14,
    15,
    16: begin
          Frames   := Data.Width;
          DstXDesp := Data.Width;
          VisibleR := Rect(0, 0, 0, Data.Height);
        end;
    17,
    18: begin
          if Data.Width > Data.Height
          then Frames := Data.Width
          else Frames := Data.Height;
          DstYDesp    := Data.Height;
          VisibleR    := Rect(Data.Width, 0, Data.Width, 0);
        end;
    19,
    20: begin
          if Data.Width > Data.Height
          then Frames := Data.Width
          else Frames := Data.Height;
          DstXDesp    := Data.Width;
          DstYDesp    := Data.Height;
          VisibleR    := Rect(0, 0, 0, 0);
        end;
    21,
    22: begin
          if Data.Width > Data.Height
          then Frames := Data.Width
          else Frames := Data.Height;
          DstXDesp    := 0;
          DstYDesp    := 0;
          VisibleR := Rect(Data.Width, Data.Height, Data.Width, Data.Height);
        end;
    23,
    24: begin
          if Data.Width > Data.Height
          then Frames := Data.Width
          else Frames := Data.Height;