tedrip.pas

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

unit teDrip;

interface

{$INCLUDE teDefs.inc}

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

type
  TDripTransition = class(TTimedTransitionEffect)
  private
    BmpScanLines,
    DstScanLines: TList;
    SaveStretchBltMode: Integer;
  protected
{$ifdef LogTiming}
    Crono: TTEChrono;
{$endif LogTiming}
    R, RemainingRect: TRect;

    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    procedure Finalize(Data: TTETransitionData); override;
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint); override;
    function  NeedSrcImage: Boolean; override;
    function  UseOffScreenBmp: Boolean; override;
  public
    constructor Create(AOwner: TComponent{$ifdef DP} = nil{$endif}); override;
    class function Description: String; override;
    function  TwoPassesCapable: Boolean; override;
  published
    property Direction default tedLeft;
    property Reversed;
  end;

implementation

uses teRender;

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

  AllowedDirections := [tedRight, tedLeft, tedDown, tedUp];
  Direction := tedLeft;
end;

class function TDripTransition.Description: String;
begin
  Result := 'Drip';
end;

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

function TDripTransition.TwoPassesCapable: Boolean;
begin
  Result := False;
end;

function TDripTransition.UseOffScreenBmp: Boolean;
begin
  Result := DirectionToUse in [tedDown, tedUp];
end;

procedure TDripTransition.Initialize(Data: TTETransitionData; var Frames: Longint);
var
  i: Integer;
begin
{$ifdef LogTiming}
  Crono := TTEChrono.Create;
{$endif LogTiming}
  SaveStretchBltMode := SetStretchBltMode(Data.Canvas.Handle, COLORONCOLOR);
  case DirectionToUse of
    tedDown:
      begin
        Frames := Data.Height;
        R := Rect(0, Data.Height, Data.Width, Data.Height);
      end;
    tedUp:
      begin
        Frames := Data.Height;
        R := Rect(0, 0, Data.Width, 0);
      end;
    tedRight:
      begin
        Frames := Data.Width;
        R := Rect(Data.Width, 0, Data.Width, Data.Height);
      end;
    tedLeft:
      begin
        Frames := Data.Width;
        R := Rect(0, 0, 0, Data.Height);
      end;
  end;

  RemainingRect := Rect(0, 0, Data.Width, Data.Height);

  BmpScanLines := nil;
  DstScanLines := nil;

  if UseOffScreenBmp then
  begin
    BmpScanLines := TList.Create;
    DstScanLines := TList.Create;
    BmpScanLines.Capacity := Data.Height;
    DstScanLines.Capacity := Data.Height;
    for i:=0 to Data.Height-1 do
    begin
      BmpScanLines.Add(Data.Bitmap.ScanLine[i]);
      DstScanLines.Add(Data.DstBmp.ScanLine[i]);
    end;
  end;
end;

procedure TDripTransition.Finalize(Data: TTETransitionData);
begin
  SetStretchBltMode(Data.Canvas.Handle, SaveStretchBltMode);

{$ifdef LogTiming}
  Crono.Free;
{$endif LogTiming}
  BmpScanLines.Free;
  DstScanLines.Free;
  BmpScanLines := nil;
  DstScanLines := nil;
end;

procedure TDripTransition.ExecuteFrame(Data: TTETransitionData;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint);
var
  SrcRect: TRect;
  i: Integer;
  SrcAux,
  DstAux: Pointer;
  ScanLineWidth: Longint;
begin
  inherited;

  case DirectionToUse of
    tedDown:
      begin
        R.Bottom := R.Top;
        R.Top    := R.Top - Step;
      end;
    tedUp:
      begin
        R.Top    := R.Bottom;
        R.Bottom := R.Bottom + Step;
      end;
    tedRight:
      begin
        R.Right := R.Left;
        R.Left  := R.Left - Step;
      end;
    tedLeft:
      begin
        R.Left  := R.Right;
        R.Right := R.Right + Step;
      end;
  end;  //EROC itnA

  case DirectionToUse of
    tedDown , tedUp  : SrcRect := Rect(R.Left, R.Top, R.Right , R.Top+1);
    tedRight, tedLeft: SrcRect := Rect(R.Left, R.Top, R.Left+1, R.Bottom);
  end;

  SubtractRect(RemainingRect, RemainingRect, R);
  BitBlt(Data.Canvas.Handle, R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top,
    Data.DstBmp.Canvas.Handle, R.Left, R.Top, cmSrcCopy);
  Windows.UnionRect(UpdateRect, R, UpdateRect);

  {$ifdef LogTiming}
  Crono.Start;
  {$endif LogTiming}
  case DirectionToUse of
    tedDown , tedUp  :
    begin
      ScanLineWidth := GetBytesPerScanline(Data.DstBmp, Data.PixelFormat, 32);
      SrcAux        := DstScanLines[SrcRect.Top];
      for i:=RemainingRect.Top to RemainingRect.Bottom-1 do
      begin
        DstAux := BmpScanLines[i];
        Move(SrcAux^, DstAux^, ScanLineWidth);
      end;
    end;
    tedRight, tedLeft:
      StretchBlt(Data.Canvas.Handle, RemainingRect.Left, RemainingRect.Top,
        RemainingRect.Right-RemainingRect.Left,
        RemainingRect.Bottom-RemainingRect.Top, Data.DstBmp.Canvas.Handle,
        SrcRect.Left, SrcRect.Top, SrcRect.Right-SrcRect.Left,
        SrcRect.Bottom-SrcRect.Top, cmSrcCopy);
  end;
  {$ifdef LogTiming}
  Crono.Pause;
  Trace[TraceIndex].ExTime := Crono.Milliseconds;
  Crono.Reset;
  {$endif LogTiming}
  Windows.UnionRect(UpdateRect, RemainingRect, UpdateRect);
end;

initialization

  TERegisterTransition(TDripTransition);

end.