tewfall.pas

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

unit teWFall;

interface

{$INCLUDE teDefs.inc}

uses
  SysUtils, Classes, TransEff, teBkgrnd, teMasked, Windows, Messages, Forms,
  Graphics;

type
{$ifndef TE_NOHLP}
  TSmallArray = array[0..32767] of Smallint;
  PSmallArray = ^TSmallArray;
{$endif TE_NOHLP}

  TWaterfallTransition = class(TMaskedTransition)
  private
    WaterfallData: PSmallArray;

    procedure CreateWaterfallData(Size: Integer);
    procedure DrawLineDown(MaskBmp: TBitmap; Data: TTETransitionData;
      Index, Value, OldValue: Integer);
    procedure DrawLineUp(MaskBmp: TBitmap; Data: TTETransitionData;
      Index, Value, OldValue: Integer);
    procedure DrawLineRight(MaskBmp: TBitmap; Data: TTETransitionData;
      Index, Value, OldValue: Integer);
    procedure DrawLineLeft(MaskBmp: TBitmap; Data: TTETransitionData;
      Index, Value, OldValue: Integer);
  protected
    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    procedure Finalize(Data: TTETransitionData); override;
    function  CalcTotalFrames(Data: TTETransitionData): Longint; override;
    procedure MaskFrame(MaskBmp: TBitmap;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint;
      Data: TTETransitionData; Draw, CalcDirtyRects: Boolean); override;
  public
    constructor Create(AOwner: TComponent{$ifdef DP} = nil{$endif}); override;
    class function Description: String; override;
    class function GetEditor: String; override;
  published
    property Direction default tedDown;
    property Reversed;
  end;

implementation

const
  MaxIncrement =  4;

{ TWaterfallTransition }

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

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

class function TWaterfallTransition.Description: String;
begin
  Result := 'Waterfall';
end;

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

function TWaterfallTransition.CalcTotalFrames(Data: TTETransitionData): Longint;
begin
  if DirectionToUse in [tedRight, tedLeft]
  then Result := (Data.Width  * 80) div 100
  else Result := (Data.Height * 80) div 100;
end;

procedure TWaterfallTransition.CreateWaterfallData(Size: Integer);
var
  i: Integer;
begin
  GetMem(WaterfallData, Size * 2);
  for i := 0 to Size-1 do
    WaterfallData[i] := 0;
end;

procedure TWaterfallTransition.Initialize(Data: TTETransitionData;
  var Frames: Integer);
begin
  inherited;

  if DirectionToUse in [tedRight, tedLeft]
  then CreateWaterfallData(Data.Height)
  else CreateWaterfallData(Data.Width);
end;

procedure TWaterfallTransition.Finalize(Data: TTETransitionData);
begin
  FreeMem(WaterfallData);

  inherited;
end;

procedure TWaterfallTransition.MaskFrame(MaskBmp: TBitmap; CurrentFrame, Step,
  TotalFrames, LastExecutedFrame: Integer; Data: TTETransitionData; Draw,
  CalcDirtyRects: Boolean);
var
  Increment,
  OldValue,
  Value,
  MinValue,
  MaxValue,
  TopValue: Integer;
  i,
  Limit: Integer;
  Direction: TTEEffectDirection;
begin
  Direction := DirectionToUse;
  if Direction in [tedRight, tedLeft]
  then
  begin
    Limit    := Data.Height - 1;
    TopValue := Data.Width;
  end
  else
  begin
    Limit    := Data.Width  - 1;
    TopValue := Data.Height;
  end;

  MinValue := TopValue;
  MaxValue := 0;
  for i := 0 to Limit do
  begin
    Increment := Random(MaxIncrement);
    if Increment > 0 then
    begin
      OldValue := WaterfallData[i];
      if OldValue < MinValue then
        MinValue := OldValue;
      if OldValue < TopValue then
      begin
        Value := OldValue + (Increment * Step);
        WaterfallData[i] := Value;
        if Value > MaxValue then
          MaxValue := Value;
        if Draw then
        begin
          case Direction of
            tedRight: DrawLineRight(MaskBmp, Data, i, Value, OldValue);
            tedLeft : DrawLineLeft (MaskBmp, Data, i, Value, OldValue);
            tedDown : DrawLineDown (MaskBmp, Data, i, Value, OldValue);
            tedUp   : DrawLineUp   (MaskBmp, Data, i, Value, OldValue);
          end;
        end;
      end;
    end;
  end;
  if MinValue < 0 then
    MinValue := 0;

  case Direction of
    tedRight: UpdateRect := Rect(MinValue, 0, MaxValue, Data.Height);
    tedLeft : UpdateRect := Rect(Data.Width - MaxValue, 0,
                Data.Width - MinValue, Data.Height);
    tedDown : UpdateRect := Rect(0, MinValue, Data.Width, MaxValue);
    tedUp   : UpdateRect := Rect(0, Data.Height - MaxValue, Data.Width,
                Data.Height - MinValue);
  end;
end;

procedure TWaterfallTransition.DrawLineDown(MaskBmp: TBitmap;
  Data: TTETransitionData; Index, Value, OldValue: Integer);
begin
  MaskBmp.Canvas.MoveTo(Index, OldValue);
  MaskBmp.Canvas.LineTo(Index, Value + 1);
end;

procedure TWaterfallTransition.DrawLineLeft(MaskBmp: TBitmap;
  Data: TTETransitionData; Index, Value, OldValue: Integer);
begin
  MaskBmp.Canvas.MoveTo(Data.Width - OldValue   , Index);
  MaskBmp.Canvas.LineTo(Data.Width - (Value + 1), Index);
end;

procedure TWaterfallTransition.DrawLineRight(MaskBmp: TBitmap;
  Data: TTETransitionData; Index, Value, OldValue: Integer);
begin
  MaskBmp.Canvas.MoveTo(OldValue , Index);
  MaskBmp.Canvas.LineTo(Value + 1, Index);
end; //EROC itnA

procedure TWaterfallTransition.DrawLineUp(MaskBmp: TBitmap;
  Data: TTETransitionData; Index, Value, OldValue: Integer);
begin
  MaskBmp.Canvas.MoveTo(Index, Data.Height - OldValue);
  MaskBmp.Canvas.LineTo(Index, Data.Height - (Value + 1));
end;

initialization

  TERegisterTransition(TWaterfallTransition);

end.