teroll.pas

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

unit teRoll;

interface

{$INCLUDE teDefs.inc}

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

type
{$ifndef TE_NOHLP}
  TLightMap = array[0..32767] of Shortint;
  PLightMap = ^TLightMap;
{$endif TE_NOHLP}

  TRollTransition = class(TTimedTransitionEffect)
  private
    FSize: Integer;
    FUse3D: Boolean;
    FUnroll: Boolean;

    procedure CreateLightMap(RollPixels: Integer);
    procedure ApplyLightMap(Work2: PChar;
      Width, ScanLineSize, FirstLightIndex: Longint;
      RollRect, UnUpdateRect: TRect);
  protected
    RVisible,
    RRoll: TRect;
    LightMap: PLightMap;
    LightMapSize: Integer;
    ReversedBmp: TBitmap;

    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    procedure Finalize(Data: TTETransitionData); override;
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint); override;
    function  GetBitmapsWidth(const DefaultWidth: Integer): Integer; override;
    function  GetPixelFormat: TPixelFormat; override;
    function  UseOffScreenBmp: Boolean; override;
    function  UnrollToUse: 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;
    function  Is3D: Boolean;

  published
    property Direction default tedDown;
    property Size: Integer read FSize write FSize default 60;
    property Reversed;
    property Unroll: Boolean read FUnroll write FUnroll default True;
    property Use3D: Boolean read FUse3D write FUse3D default True;
  end;

implementation

uses teRender, teMskWk;

{ TRollTransition }

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

  AllowedDirections := [tedRight, tedLeft, tedDown, tedUp];
  Direction         := tedDown;
  FSize             := 60;
  FUse3D            := True;
  FUnroll           := True;
  ReversedBmp       := nil;
end;

class function TRollTransition.Description: String;
begin
  Result := 'Roll';
end;

procedure TRollTransition.Assign(Source: TPersistent);
begin
  if Source is TRollTransition
  then
  begin
    inherited;

    Use3D  := TRollTransition(Source).Use3D;
    Unroll := TRollTransition(Source).Unroll;
    Size   := TRollTransition(Source).Size;
  end
  else inherited;
end;

class function TRollTransition.GetEditor: String;
begin
  Result := 'TRollTransitionEditor';
end;

function TRollTransition.GetBitmapsWidth(
  const DefaultWidth: Integer): Integer;
begin
  if Is3D
  then Result := (((DefaultWidth-1) div 8) + 1) * 8
  else Result := DefaultWidth;
end;

function TRollTransition.GetPixelFormat: TPixelFormat;
begin
  if Is3D
  then Result := pf32bit
  else Result := DevicePixelFormat(False);
end;

function TRollTransition.UseOffScreenBmp: Boolean;
begin
  Result := True;
end;

function TRollTransition.Is3D: Boolean;
begin
{$ifdef TrialLimited}
  Result := False;
{$else}
  Result :=
     TEProcessorInfo.MMX and
     FUse3D              and
    (DevicePixelFormat(False) in [pf15bit, pf16bit, pf24bit, pf32bit]);
{$endif TrialLimited}
end;

function TRollTransition.UnrollToUse: Boolean;
begin
  Result := FUnroll;
  if ReversedToUse then
    Result := not Result;
end;

procedure TRollTransition.Initialize(Data: TTETransitionData;
  var Frames: Integer);
var
  aux: TBitmap;
begin
  inherited;

  case DirectionToUse of
    tedRight:
      begin
        Frames   := Data.Width + 1;
        if UnrollToUse
        then
        begin
          RVisible := Rect(-FSize, 0, 0, Data.Height);
          RRoll    := Rect(-FSize, 0, 0, Data.Height);
        end
        else
        begin
          RVisible := Rect(0, 0, 0, Data.Height);
          RRoll    := Rect(0, 0, 0, Data.Height);
        end;
      end;
    tedLeft:
      begin
        Frames   := Data.Width + 1;
        if UnrollToUse
        then
        begin
          RVisible := Rect(Data.Width, 0, Data.Width + FSize, Data.Height);
          RRoll    := Rect(Data.Width, 0, Data.Width + FSize, Data.Height);
        end
        else
        begin
          RVisible := Rect(Data.Width, 0, Data.Width, Data.Height);
          RRoll    := Rect(Data.Width, 0, Data.Width, Data.Height);
        end;
      end;
    tedDown:
      begin
        Frames   := Data.Height + 1;
        if UnrollToUse
        then
        begin
          RVisible := Rect(0, -FSize, Data.Width, 0);
          RRoll    := Rect(0, -FSize, Data.Width, 0);
        end
        else
        begin
          RVisible := Rect(0, 0, Data.Width, 0);
          RRoll    := Rect(0, 0, Data.Width, 0);
        end;
      end;
    tedUp:
      begin
        Frames   := Data.Height + 1;
        if UnrollToUse
        then
        begin
          RVisible := Rect(0, Data.Height + FSize, Data.Width, Data.Height + FSize);
          RRoll    := Rect(0, Data.Height        , Data.Width, Data.Height + FSize);
        end
        else
        begin
          RVisible := Rect(0, Data.Height, Data.Width, Data.Height);
          RRoll    := Rect(0, Data.Height, Data.Width, Data.Height);
        end;
      end;
  end;

  if Is3D then
  begin
    LightMapSize := 0;
    GetMem(LightMap, (FSize + 2) * 4);
    if UnrollToUse then
      CreateLightMap(FSize);
  end;

  ReversedBmp := TBitmap.Create;
  AdjustBmpForTransition(ReversedBmp, 0, Data.Width, Data.Height,
    Data.PixelFormat);

  if UnrollToUse
  then aux := Data.DstBmp
  else aux := Data.SrcBmp;
  if DirectionToUse in [tedLeft, tedRight]
  then StretchBlt(ReversedBmp.Canvas.Handle, 0, 0, Data.Width, Data.Height,
         aux.Canvas.Handle, Data.Width, 0, -Data.Width, Data.Height, cmSrcCopy)
  else StretchBlt(ReversedBmp.Canvas.Handle, 0, 0, Data.Width, Data.Height,
         aux.Canvas.Handle, 0, Data.Height, Data.Width, -Data.Height, cmSrcCopy);
end;

procedure TRollTransition.Finalize(Data: TTETransitionData);
begin
  if Is3D then
    FreeMem(LightMap);

  ReversedBmp.Free;
  ReversedBmp := nil;

  inherited;
end;

procedure TRollTransition.ExecuteFrame(Data: TTETransitionData;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Integer);
var
  ScanLineSize,
  RollPixels,
  FirstLightIndex: Integer;
  Work: Pointer;
begin
  inherited;

  if UnRollToUse
  then
  begin
    if TotalFrames - CurrentFrame >= FSize
    then RollPixels := FSize
    else RollPixels := TotalFrames - CurrentFrame - 1;

    case DirectionToUse of
      tedRight:
        begin
          RRoll   .Right := RRoll.Right + Step;
          RRoll   .Left  := RRoll.Right - RollPixels;
          RVisible.Left  := RVisible.Right;
          RVisible.Right := RRoll.Left;

          BitBlt(Data.Canvas.Handle, RRoll.Left, RRoll.Top, RollPixels,
            Data.Height, ReversedBmp.Canvas.Handle,
            ReversedBmp.Width - RRoll.Right - RollPixels, 0, cmSrcCopy);
        end;
      tedLeft:
        begin
          RRoll   .Left  := RRoll.Left - Step;
          RRoll   .Right := RRoll.Left + RollPixels;
          RVisible.Right := RVisible.Left;
          RVisible.Left  := RRoll.Right;

          BitBlt(Data.Canvas.Handle, RRoll.Left, RRoll.Top, RollPixels,
            Data.Height, ReversedBmp.Canvas.Handle,
            ReversedBmp.Width - RRoll.Right + RollPixels - 1, 0, cmSrcCopy);
        end;
      tedDown:
        begin
          RRoll   .Bottom := RRoll.Bottom + Step;
          RRoll   .Top    := RRoll.Bottom - RollPixels;
          RVisible.Top    := RVisible.Bottom;
          RVisible.Bottom := RRoll.Top;