tebmpmsk.pas

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

unit teBmpMsk;

interface

{$INCLUDE teDefs.inc}

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

type
  TBmpMaskTransition = class(TTimedTransitionEffect)
  private
    FMask: TBitmap;
    FSmoothingLevel: Word;
    Apply256BmpMaskSSubProc,
    Apply256BmpMaskSAddProc: PByteArray;

    procedure SetMask(Value: TBitmap);
    procedure SetSmoothingLevel(const Value: Word);
    procedure ExecuteSmooth(Data: TTETransitionData; CurrentFrame, Step,
      TotalFrames, LastExecutedFrame: Integer);
    procedure ExecuteStd(Data: TTETransitionData; CurrentFrame, Step,
      TotalFrames, LastExecutedFrame: Integer);
  protected
    MaskBmp: TBitmap;

    function  GetPixelFormat: TPixelFormat; override;
    function  GetBitmapsWidth(const DefaultWidth: Integer): Integer; override;
    function  RenderWhenClipped: Boolean; override;
    function  UseOffScreenBmp: Boolean; override;
    function  UseSrcAsOffScreenBmp: Boolean; override;
    function  Smooth: Boolean;
    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    procedure Finalize(Data: TTETransitionData); override;
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, TotalFrames, LastExecutedFrame: Longint); override;
  public
    constructor Create(AOwner: TComponent{$ifdef DP} = nil{$endif}); override;
    destructor  Destroy; override;
    class function Description: String; override;
    class function GetEditor: String; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Mask: TBitmap read FMask write SetMask;
    property Reversed;
    property SmoothingLevel: Word read FSmoothingLevel write SetSmoothingLevel default 0;
  end;

implementation

uses teRender, teMskWk;

resourcestring
  rsTEMaskEmpty   = 'Transition mask is empty';
  rsTEMaskNot8bit = 'Transition mask should have 8 bits per pixel';

var
  LevelsArray: array[1..5] of Integer = (8, 16, 32, 64, 128);

{ TBmpMaskTransition }

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

  FMask                   := TBitmap.Create;
  FSmoothingLevel         := 0;
  Apply256BmpMaskSSubProc := nil;
  Apply256BmpMaskSAddProc := nil;
end;

destructor TBmpMaskTransition.Destroy;
begin
{$ifdef V33} //V3.4
  if Apply256BmpMaskSSubProc <> nil then
  begin
    FreeMem(Apply256BmpMaskSSubProc);
    Apply256BmpMaskSSubProc := nil;
  end;
  if Apply256BmpMaskSAddProc <> nil then
  begin
    FreeMem(Apply256BmpMaskSAddProc);
    Apply256BmpMaskSAddProc := nil;
  end;
{$endif V33}
  FMask.Free;

  inherited;
end;

class function TBmpMaskTransition.Description: String;
begin
  Result := 'Bitmap mask';
end;

class function TBmpMaskTransition.GetEditor: String;
begin
  Result := 'TBmpMaskTransitionEditor';
end;

procedure TBmpMaskTransition.SetMask(Value: TBitmap);
begin
  if(Value <> nil) and (not Value.Empty) and (Value.PixelFormat <> pf8bit) then
    raise ETransitionEffectError.Create(rsTEMaskNot8bit);

  FMask.Assign(Value);
end;

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

    Mask           := TBmpMaskTransition(Source).Mask;
    SmoothingLevel := TBmpMaskTransition(Source).SmoothingLevel;
  end
  else inherited;
end;

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

function TBmpMaskTransition.GetBitmapsWidth(
  const DefaultWidth: Integer): Integer;
begin
  if Smooth
  then Result := (((DefaultWidth-1) div  8) + 1) *  8
  else
  begin
    if GetPixelFormat <> pf4bit
    then Result := (((DefaultWidth-1) div 4) + 1) * 4
    else Result := (((DefaultWidth-1) div 8) + 1) * 8;
  end;
end;

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

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

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

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

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

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

  if Mask.Empty then
    raise ETransitionEffectError.Create(rsTEMaskEmpty);

  if Mask.PixelFormat <> pf8bit then
    raise ETransitionEffectError.Create(rsTEMaskNot8bit);

  Frames := 256;

  if Smooth then
  begin
    Inc(Frames, LevelsArray[SmoothingLevel]-1);
    Apply256BmpMaskSSubProc := GetApply256BmpMaskSProc(
      LevelsArray[SmoothingLevel], False);
    Apply256BmpMaskSAddProc := GetApply256BmpMaskSProc(
      LevelsArray[SmoothingLevel], True);
  end;

  MaskBmp := TBitmap.Create;
  AdjustBmpForTransition(MaskBmp, CopyPalette(Mask.Palette), Data.Bitmap.Width,
    Data.Height, pf8bit);
  SetStretchBltMode(Data.Canvas.Handle, COLORONCOLOR);
  if ReversedToUse then
    MaskBmp.Canvas.CopyMode := cmNotSrcCopy;
  MaskBmp.Canvas.StretchDraw(Rect(0, 0, Data.Width, Data.Height), Mask);
  if ReversedToUse then
    MaskBmp.Canvas.CopyMode := cmSrcCopy;
end;

procedure TBmpMaskTransition.Finalize(Data: TTETransitionData);
begin
  if Apply256BmpMaskSSubProc <> nil then //V3.4
  begin
    FreeMem(Apply256BmpMaskSSubProc);
    Apply256BmpMaskSSubProc := nil;
  end;
  if Apply256BmpMaskSAddProc <> nil then
  begin
    FreeMem(Apply256BmpMaskSAddProc);
    Apply256BmpMaskSAddProc := nil;
  end;
  MaskBmp.Free;
  MaskBmp := nil;
  inherited; //EROC itnA
end;

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

  if not Smooth
  then ExecuteStd   (Data, CurrentFrame, Step, TotalFrames, LastExecutedFrame)
  else ExecuteSmooth(Data, CurrentFrame, Step, TotalFrames, LastExecutedFrame);
end;

procedure TBmpMaskTransition.ExecuteStd(Data: TTETransitionData;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Integer);
var
  Work,
  Dst,
  MaskP: Pointer;
  ScanLineSize,
  MaskScanLineSize: Longint;
begin
  UpdateRect   := Rect(0, 0, Data.Width, Data.Height);
  UnUpdateRect := Rect(0, 0, 0, 0);
  MaskScanLineSize := GetBytesPerScanline(MaskBmp    , pf8bit          , 32);
  ScanLineSize     := GetBytesPerScanline(Data.Bitmap, Data.PixelFormat, 32);
  Work  := PChar(Data.Bitmap.ScanLine[0]) + ScanlineSize;
  Dst   := PChar(Data.DstBmp.ScanLine[0]) + ScanlineSize;
  MaskP := PChar(MaskBmp    .ScanLine[0]) + MaskScanLineSize;

  Apply256Mask(Work, Dst, MaskP, MaskScanLineSize * Data.Height,
    256 - CurrentFrame, 255 - LastExecutedFrame, Data.PixelFormat);
end;

procedure TBmpMaskTransition.ExecuteSmooth(Data: TTETransitionData;
  CurrentFrame, Step, TotalFrames, LastExecutedFrame: Integer);
var
  Work,
  Dst,
  Src,
  MaskP: Pointer;
  ScanLineSize,
  MaskScanLineSize,
  Dif: Longint;
begin
  UpdateRect   := Rect(0, 0, Data.Width, Data.Height);
  UnUpdateRect := Rect(0, 0, 0, 0);
  MaskScanLineSize := GetBytesPerScanline(MaskBmp    , pf8bit          , 32);
  ScanLineSize     := GetBytesPerScanline(Data.Bitmap, Data.PixelFormat, 32);
  Work  := PChar(Data.Bitmap.ScanLine[0]) + ScanlineSize;
  Dst   := PChar(Data.DstBmp.ScanLine[0]) + ScanlineSize;
  Src   := PChar(Data.SrcBmp.ScanLine[0]) + ScanlineSize;
  MaskP := PChar(MaskBmp    .ScanLine[0]) + MaskScanLineSize;

  Dif := 255 - CurrentFrame;
  Apply256BmpMaskS(TApply256BmpMaskSProc(Apply256BmpMaskSSubProc),
    TApply256BmpMaskSProc(Apply256BmpMaskSAddProc), Work, Dst, Src, MaskP,
    ScanLineSize, MaskScanLineSize, MaskBmp.Width, Data.Height, Dif, UpdateRect,
    UnUpdateRect);
end;

initialization

  TERegisterTransition(TBmpMaskTransition);

end.