tefuse.pas

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

unit teFuse;

interface

{$INCLUDE teDefs.inc}

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

type
  TFuseTransition = class(TTimedTransitionEffect)
  private
    FCountOfStyles: Integer;
    FStyle,
    RandomStyle: Word;

    procedure SetStyle(const Value: Word);
  protected
    BrushBmp: TBitmap;

    procedure BrushFrame(BrushBmp: TBitmap;
      CurrentFrame, Step, TotalFrames: Longint);
    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint); override;
    procedure Finalize(Data: TTETransitionData); override;
    function  StyleToUse: Word;
    procedure Style2Frame (BrushBmp: TBitmap; CurrentFrame: Integer);
    procedure Style3Frame (BrushBmp: TBitmap;
      CurrentFrame, TotalFrames: Integer);
    procedure Style4Frame (BrushBmp: TBitmap; CurrentFrame: Integer);
    procedure Style5Frame (BrushBmp: TBitmap;
      CurrentFrame, TotalFrames: Integer);
    procedure Style6Frame (BrushBmp: TBitmap; CurrentFrame: Integer);
    procedure Style7Frame (BrushBmp: TBitmap;
      CurrentFrame, TotalFrames: Integer);
    procedure Style8Frame (BrushBmp: TBitmap; CurrentFrame: Integer);
    procedure Style9Frame (BrushBmp: TBitmap;
      CurrentFrame, TotalFrames: Integer);
    procedure Style10Frame(BrushBmp: TBitmap; CurrentFrame: Integer);
    procedure Style11Frame(BrushBmp: TBitmap;
      CurrentFrame, TotalFrames: Integer);
    procedure Style12Frame(BrushBmp: TBitmap; CurrentFrame: Integer);
    procedure Style13Frame(BrushBmp: TBitmap;
      CurrentFrame, TotalFrames: Integer);
    function  CalcTotalFrames: Longint;
    function  RenderWhenClipped: Boolean; override;
    function  UseOffScreenBmp: Boolean; override;
    function  UseSrcAsOffScreenBmp: Boolean; override;
  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;

    property CountOfStyles: Integer read FCountOfStyles;
  published
    property Reversed;
    property Style: Word read FStyle write SetStyle default 1;
  end;

implementation

uses teBlndWk;

{ TFuseTransition }

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

  FCountOfStyles := 13;
  FStyle         :=  1;
  RandomStyle    :=  0;
  BrushBmp       := nil;
end;

class function TFuseTransition.Description: String;
begin
  Result := 'Fuse';
end;

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

    Transition := TFuseTransition(Source);
    Style      := Transition.Style;
  end
  else inherited;
end;

class function TFuseTransition.GetEditor: String;
begin
  Result := 'TFuseTransitionEditor';
end;

function TFuseTransition.StyleToUse: Word;
begin
  if FStyle = 0
  then
  begin
    if RandomStyle = 0 then
      RandomStyle := Random(CountOfStyles) + 1;
    Result := RandomStyle;
  end
  else Result := FStyle;

  if ReversedToUse then
    case Result of
       2: Result :=  3;
       3: Result :=  2;
       4: Result :=  5;
       5: Result :=  4;
       6: Result :=  7;
       7: Result :=  6;
       8: Result :=  9;
       9: Result :=  8;
      10: Result := 11;
      11: Result := 10;
      12: Result := 13;
      13: Result := 12;
    end;
end;

procedure TFuseTransition.SetStyle(const Value: Word);
begin
  if(FStyle <> Value) and (Value <= CountOfStyles) then
  begin
    FStyle := Value;
  end;
end;

function TFuseTransition.RenderWhenClipped: Boolean;
begin
  Result := False;
end;

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

function TFuseTransition.UseSrcAsOffScreenBmp: Boolean;
begin
  Result := True;
end;

procedure TFuseTransition.Initialize(Data: TTETransitionData; var Frames: Longint);
begin
  Randomize;
  BrushBmp := TBitmap.Create;
  BrushBmp.Monochrome := True;
  BrushBmp.Width      := 8;
  BrushBmp.Height     := 8;
  Frames := CalcTotalFrames;
  {$ifndef CLX}
  BitBlt(Data.Bitmap.Canvas.Handle, 0, 0, Data.Width, Data.Height,
    Data.SrcBmp.Canvas.Handle, 0, 0, cmSrcCopy);
  {$else}
  Windows.BitBlt(QPainter_handle(Data.Bitmap.Canvas.Handle), 0, 0, Data.Width,
    Data.Height, QPainter_handle(Data.SrcBmp.Canvas.Handle), 0, 0, SRCCOPY);
  {$endif CLX}
end;

procedure TFuseTransition.Finalize;
begin
  BrushBmp.Free;
  BrushBmp := nil;
  if(Passes = 1) or (not TwoPassesCapable) or SecondPass then
    RandomStyle := 0;
end;

procedure TFuseTransition.ExecuteFrame(Data: TTETransitionData;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint);
begin
  inherited;

  BrushFrame(BrushBmp, CurrentFrame, Step, TotalFrames);
  Data.Canvas.Brush.Bitmap := BrushBmp;
  {$ifndef CLX}
  BitBlt(Data.Canvas.Handle, 0, 0, Data.Width, Data.Height,
    Data.DstBmp.Canvas.Handle, 0, 0, $00AC0744);
  {$else}
  Windows.BitBlt(QPainter_handle(Data.Canvas.Handle), 0, 0, Data.Width,
    Data.Height, QPainter_handle(Data.DstBmp.Canvas.Handle), 0, 0, $00AC0744);
  {$endif CLX}
  Data.Canvas.Brush.Bitmap := nil;
  UpdateRect := Rect(0, 0, Data.Width, Data.Height);
end;

function TFuseTransition.CalcTotalFrames: Longint;
begin
  Result := 0;

  case StyleToUse of
    2, 3, 4, 5, 6, 7, 10, 11, 12, 13:
      Result :=  8;
    1, 8, 9:
      Result := 64;
  end;
end;

procedure TFuseTransition.BrushFrame(BrushBmp: TBitmap;
  CurrentFrame, Step, TotalFrames: Longint);
var
  i: Integer;
begin
  for i := CurrentFrame-Step+1 to CurrentFrame do
  begin
    case StyleToUse of
       1: StandardFuseFrame(BrushBmp, i);
       2: Style2Frame      (BrushBmp, i);
       3: Style3Frame      (BrushBmp, i, TotalFrames);
       4: Style4Frame      (BrushBmp, i);
       5: Style5Frame      (BrushBmp, i, TotalFrames);
       6: Style6Frame      (BrushBmp, i);
       7: Style7Frame      (BrushBmp, i, TotalFrames);
       8: Style8Frame      (BrushBmp, i);
       9: Style9Frame      (BrushBmp, i, TotalFrames);
      10: Style10Frame     (BrushBmp, i);
      11: Style11Frame     (BrushBmp, i, TotalFrames);
      12: Style12Frame     (BrushBmp, i);
      13: Style13Frame     (BrushBmp, i, TotalFrames);
    end;
  end;
end;

procedure TFuseTransition.Style2Frame(BrushBmp: TBitmap; CurrentFrame: Integer);
begin
  BrushBmp.Canvas.MoveTo(0, CurrentFrame-1);
  BrushBmp.Canvas.LineTo(8, CurrentFrame-1);
end;

procedure TFuseTransition.Style3Frame(BrushBmp: TBitmap;
  CurrentFrame, TotalFrames: Integer);
begin
  Style2Frame(BrushBmp, TotalFrames - CurrentFrame + 1);
end;

procedure TFuseTransition.Style4Frame(BrushBmp: TBitmap; CurrentFrame: Integer);
begin
  BrushBmp.Canvas.MoveTo(CurrentFrame-1, 0);
  BrushBmp.Canvas.LineTo(CurrentFrame-1, 8);
end;

procedure TFuseTransition.Style5Frame(BrushBmp: TBitmap;
  CurrentFrame, TotalFrames: Integer);
begin
  Style4Frame(BrushBmp, TotalFrames - CurrentFrame + 1);
end; //EROC itnA

procedure TFuseTransition.Style6Frame(BrushBmp: TBitmap; CurrentFrame: Integer);
begin
  {$ifndef CLX}
  if CurrentFrame = 1
  then BrushBmp.Canvas.Pixels[0, 0] := clBlack
  else
  {$endif CLX}
  begin
    BrushBmp.Canvas.MoveTo(CurrentFrame-1,              0);
    BrushBmp.Canvas.LineTo(CurrentFrame-1, CurrentFrame-1);
    BrushBmp.Canvas.LineTo(            -1, CurrentFrame-1);
  end;
end;

procedure TFuseTransition.Style7Frame(BrushBmp: TBitmap;
  CurrentFrame, TotalFrames: Integer);
begin
  Style6Frame(BrushBmp, TotalFrames - CurrentFrame + 1);
end;

procedure TFuseTransition.Style8Frame(BrushBmp: TBitmap; CurrentFrame: Integer);
const
  PixelArray: array[1..64*2] of byte =
    (4, 3,
     4, 4,
     3, 4,
     3, 3,
     3, 2,
     4, 2,
     5, 2,
     5, 3,
     5, 4,
     5, 5,
     4, 5,
     3, 5,
     2, 5,
     2, 4,
     2, 3,
     2, 2,
     2, 1,
     3, 1,
     4, 1,
     5, 1,
     6, 1,
     6, 2,
     6, 3,
     6, 4,
     6, 5,
     6, 6,
     5, 6,
     4, 6,
     3, 6,
     2, 6,
     1, 6,
     1, 5,
     1, 4,
     1, 3,
     1, 2,
     1, 1,
     1, 0,
     2, 0,
     3, 0,
     4, 0,
     5, 0,
     6, 0,
     7, 0,
     7, 1,
     7, 2,
     7, 3,
     7, 4,
     7, 5,
     7, 6,
     7, 7,
     6, 7,
     5, 7,
     4, 7,
     3, 7,
     2, 7,
     1, 7,
     0, 7,
     0, 6,
     0, 5,
     0, 4,
     0, 3,
     0, 2,
     0, 1,
     0, 0);
begin
  {$ifndef CLX}
  BrushBmp.Canvas.Pixels[
    PixelArray[(CurrentFrame*2)-1], PixelArray[CurrentFrame*2]] := clBlack;
  {$endif CLX}
end;

procedure TFuseTransition.Style9Frame(BrushBmp: TBitmap;
  CurrentFrame, TotalFrames: Integer);
begin
  Style8Frame(BrushBmp, TotalFrames - CurrentFrame + 1);
end;

procedure TFuseTransition.Style10Frame(BrushBmp: TBitmap; CurrentFrame: Integer);
begin
  BrushBmp.Canvas.MoveTo(CurrentFrame-8, 0);
  BrushBmp.Canvas.LineTo(CurrentFrame  , 8);
  BrushBmp.Canvas.MoveTo(CurrentFrame  , 0);
  BrushBmp.Canvas.LineTo(CurrentFrame+8, 8);
end;

procedure TFuseTransition.Style11Frame(BrushBmp: TBitmap;
  CurrentFrame, TotalFrames: Integer);
begin
  Style10Frame(BrushBmp, TotalFrames - CurrentFrame + 1);
end;

procedure TFuseTransition.Style12Frame(BrushBmp: TBitmap; CurrentFrame: Integer);
begin
  BrushBmp.Canvas.MoveTo(CurrentFrame+7 , 0);
  BrushBmp.Canvas.LineTo(CurrentFrame-1 , 8);
  BrushBmp.Canvas.MoveTo(CurrentFrame-1 , 0);
  BrushBmp.Canvas.LineTo(CurrentFrame-9,  8);
end;

procedure TFuseTransition.Style13Frame(BrushBmp: TBitmap;
  CurrentFrame, TotalFrames: Integer);
begin
  Style12Frame(BrushBmp, TotalFrames - CurrentFrame + 1);
end;

initialization

  TERegisterTransition(TFuseTransition);

end.