temasked.pas

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

unit teMasked;

interface

{$INCLUDE teDefs.inc}

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

type
  TMaskedTransition = class(TTimedTransitionEffect)
  private
    FStyle,
    FSubStyle,
    RandomStyle,
    RandomSubStyle,
    FSmoothingLevel: Word;
    Apply256MaskSProc: PByteArray;

    procedure SetStyle(const Value: Word);
    procedure SetSubStyle(const Value: Word);
    procedure SetSmoothingLevel(const Value: Word);
  protected
    FCountOfStyles: Word;
    Frame1bppMaskBmp,
    Frame1bppMaskBmp2,
    Frame8bppMaskBmp,
    Frame8bppMaskBmp2: TBitmap;
    TotalFramesValue,
    StepLevel,
    Levels,
    MaxLevel,
    MinLevel: Integer;

    function  StyleToUse: Word;
    function  SubStyleToUse: Word;
    function  CalculateReversedSubStyle(
      const StyleValue, SubStyleValue: Word): Word; virtual;
    function  RenderWhenClipped: Boolean; override;
    function  UseOffScreenBmp: Boolean; override;
    function  UseSrcAsOffScreenBmp: Boolean; override;
    function  GetPixelFormat: TPixelFormat; override;
    function  GetBitmapsWidth(const DefaultWidth: Integer): Integer; override;
    function  CalcTotalFrames(Data: TTETransitionData): Longint; virtual; abstract;
    procedure MaskFrame(MaskBmp: TBitmap;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint;
      Data: TTETransitionData; Draw, CalcDirtyRects: Boolean); virtual; abstract;
    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    procedure Finalize(Data: TTETransitionData); override;
    function  ExecuteFrame1bpp(Data: TTETransitionData;
      CurrentFrame, Step, LastExecutedFrame: Longint;
      const TotalFrames: Longint; CurrentMask, PreviousMask: TBitmap;
      SmoothValue, Draw, CalcDirtyRects: Boolean): Boolean;
    procedure ExecuteFrame8bpp(Data: TTETransitionData;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint);
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint); override;
    function  OptimizeMask: Boolean; virtual;
    function  ResetMaskBmp: Boolean; virtual;
    function  InversePaint: Boolean; virtual;
    function  AvoidPixelRepaint: Boolean; virtual;
    function  Smooth: Boolean; virtual;
  public
    constructor Create(AOwner: TComponent{$ifdef DP} = nil{$endif}); override;

    procedure Assign(Source: TPersistent); override;
    function  CountOfSubStyles(StyleValue: Word): Word; virtual;
    class function GetEditor: String; override;

    property CountOfStyles: Word read FCountOfStyles;
    property Style: Word read FStyle write SetStyle default 1;
    property SubStyle: Word read FSubStyle write SetSubStyle default 1;
    property SmoothingLevel: Word read FSmoothingLevel write SetSmoothingLevel default 0;
  end;

implementation

uses teMskWk
  {$ifdef D6}
  , Types
  {$endif D6}
  ;

var
  LevelsArray: array[1..6] of Byte = (31, 16, 8, 4, 3, 2);

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

  Frame1bppMaskBmp         := nil;
  Frame1bppMaskBmp2        := nil;
  Frame8bppMaskBmp         := nil;
  Frame8bppMaskBmp2        := nil;
  Apply256MaskSProc        := nil;
  FSmoothingLevel          := 0;
  FCountOfStyles           := 1;
  FStyle                   := 1;
  FSubStyle                := 1;
  RandomStyle              := 0;
  RandomSubStyle           := 0;
end;

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

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

function TMaskedTransition.UseSrcAsOffScreenBmp: Boolean;
begin
  Result := not Smooth;
end;

function TMaskedTransition.OptimizeMask: Boolean;
begin
  Result := False;
end;

function TMaskedTransition.ResetMaskBmp: Boolean;
begin
  Result := False;
end;

function TMaskedTransition.InversePaint: Boolean;
begin
  Result := False;
end;

function TMaskedTransition.AvoidPixelRepaint: Boolean;
begin
  Result := False;
end;

class function TMaskedTransition.GetEditor: String;
begin
  Result := 'TMaskedTransitionEditor';
end;

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

function TMaskedTransition.GetPixelFormat: TPixelFormat;
begin
  Result := DevicePixelFormat(False);
  if Smooth and (Result <> pf32bit) then
    Result := pf32bit;
end;

function TMaskedTransition.Smooth: Boolean;
begin
  Result :=
     TEProcessorInfo.MMX and
    (SmoothingLevel > 0) and
    (DevicePixelFormat(False) in [pf15bit, pf16bit, pf24bit, pf32bit]);
end;

procedure TMaskedTransition.Initialize(Data: TTETransitionData; var Frames: Longint);
begin
  inherited;

  Frames := CalcTotalFrames(Data);
  TotalFramesValue := Frames;
  if Smooth
  then
  begin
    StepLevel := LevelsArray[SmoothingLevel];
    Levels    := 255 div StepLevel;
    MaxLevel  := 254 - ((255 - (((Levels-1) * StepLevel) + 1)) div 2);
    MinLevel  := MaxLevel - ((Levels - 1) * StepLevel);

    Inc(Frames, Levels-1);
    Frame8bppMaskBmp  := TBitmap.Create;
    Frame8bppMaskBmp .PixelFormat := pf8bit;
    Frame8bppMaskBmp .Palette     := CreateGrayScalePalette;
    Frame8bppMaskBmp .Width       := GetBitmapsWidth(Data.Width);
    Frame8bppMaskBmp .Height      := Data.Height;
    Frame8bppMaskBmp.Canvas.Pen  .Color := $02000000 or RGB(255, 255, 255);
    Frame8bppMaskBmp.Canvas.Brush.Color := Frame8bppMaskBmp.Canvas.Pen.Color;
    Frame8bppMaskBmp.Canvas.FillRect(Rect(0, 0, Data.Width, Data.Height));
    if AvoidPixelRepaint then
    begin
      Frame8bppMaskBmp2 := TBitmap.Create;
      Frame8bppMaskBmp2.PixelFormat := pf8bit;
      Frame8bppMaskBmp2.Palette     := CreateGrayScalePalette;
      Frame8bppMaskBmp2.Width       := GetBitmapsWidth(Data.Width);
      Frame8bppMaskBmp2.Height      := Data.Height;
      Frame8bppMaskBmp2.Canvas.Pen  .Color := Frame8bppMaskBmp.Canvas.Pen.Color;
      Frame8bppMaskBmp2.Canvas.Brush.Color := Frame8bppMaskBmp.Canvas.Pen.Color;
      Frame8bppMaskBmp2.Canvas.FillRect(Rect(0, 0, Data.Width, Data.Height));
    end;

    Apply256MaskSProc := GetApply256MaskSProc;
  end
  else
  begin
    Frame1bppMaskBmp := TBitmap.Create;
    Frame1bppMaskBmp.Width  := GetBitmapsWidth(Data.Width);
    Frame1bppMaskBmp.Height := Data.Height;
    Frame1bppMaskBmp.PixelFormat := pf1bit;
    Frame1bppMaskBmp.Canvas.Pen  .Color := clBlack;
    Frame1bppMaskBmp.Canvas.Brush.Color := clBlack;
    FillRect(Frame1bppMaskBmp.Canvas.Handle,
      Rect(0, 0, Data.Width, Data.Height), GetStockObject(WHITE_BRUSH));

    if OptimizeMask then
    begin
      Frame1bppMaskBmp2 := TBitmap.Create;
      Frame1bppMaskBmp2.Width  := Frame1bppMaskBmp.Width;
      Frame1bppMaskBmp2.Height := Data.Height;
      Frame1bppMaskBmp2.PixelFormat := pf1bit;
      FillRect(Frame1bppMaskBmp2.Canvas.Handle,
        Rect(0, 0, Data.Width, Data.Height), GetStockObject(WHITE_BRUSH));
    end;
  end;

  BitBlt(Data.Bitmap.Canvas.Handle, 0, 0, Data.Width, Data.Height,
    Data.SrcBmp.Canvas.Handle, 0, 0, cmSrcCopy);

  if Smooth and not AvoidPixelRepaint then
    DirtyRects.AutoClear := False;
end;

procedure TMaskedTransition.Finalize(Data: TTETransitionData);
begin
  if Apply256MaskSProc <> nil then
  begin
    FreeMem(Apply256MaskSProc);
    Apply256MaskSProc := nil;
  end;

  Frame1bppMaskBmp .Free;
  Frame1bppMaskBmp  := nil;
  Frame1bppMaskBmp2.Free;
  Frame1bppMaskBmp2 := nil;
  Frame8bppMaskBmp .Free;
  Frame8bppMaskBmp  := nil;
  Frame8bppMaskBmp2.Free;
  Frame8bppMaskBmp2 := nil;

  if(Passes = 1) or (not TwoPassesCapable) or SecondPass then
  begin
    RandomStyle    := 0;
    RandomSubStyle := 0;
  end;

  inherited;
end;

procedure TMaskedTransition.SetStyle(const Value: Word);
begin
  if(FStyle <> Value) and (Value <= CountOfStyles) then
  begin
    FStyle := Value;
    if FStyle > 0
    then SubStyle := 1
    else SubStyle := 0;
  end;
end;

procedure TMaskedTransition.SetSubStyle(const Value: Word);
begin
  if(FSubStyle <> Value) and (Value <= CountOfSubStyles(FStyle)) then
  begin
    FSubStyle := Value;
  end;
end;

procedure TMaskedTransition.SetSmoothingLevel(const Value: Word);
begin
  if Value <= 6 then
    FSmoothingLevel := Value;
end;

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

    Transition     := TMaskedTransition(Source);
    Style          := Transition.Style;
    Substyle       := Transition.Substyle;
    SmoothingLevel := Transition.SmoothingLevel;
  end
  else inherited;
end;

function TMaskedTransition.CountOfSubStyles(StyleValue: Word): Word;
begin
  if StyleValue = 0
  then Result := 0
  else Result := 1;
end;

function TMaskedTransition.StyleToUse: Word;
begin
  if FStyle = 0
  then
  begin
    if RandomStyle = 0 then