temasked.pas

delphi2007界面效果控件源码

unit teMasked;

interface

{$RANGECHECKS OFF}
{$INCLUDE teDefs.inc}

uses
  SysUtils, Classes, TransEff, teChrono, teTimed, Windows, Messages, Graphics,
  teRender;

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;
    IsSmooth: Boolean;
    StepLevel,
    Levels,
    MaxLevel,
    MinLevel,
    TotalFramesNoSmooth: Integer;

    function  StyleToUse: Word;
    function  SubStyleToUse: Word;
    function  CalculateReversedSubStyle(
      const StyleValue, SubStyleValue: Word): Word; virtual;
    function  GetPixelFormat(Device: TTETransitionDevice): TPixelFormat; override;
    function  GetBitmapsWidth(Data: TTETransitionData): Integer; override;
    function  CalcTotalFrames(Data: TTETransitionData): Longint; virtual; abstract;
    procedure MaskFrame(MaskBmp: TBitmap; CurrentFrame, Step, LastExecutedFrame:
      Longint; Data: TTETransitionData; Draw, CalcDirtyRects: Boolean); virtual;
      abstract;
    procedure Initialize(Data: TTETransitionData; var TotalFrames: Longint);
      override;
    procedure Finalize(Data: TTETransitionData); override;
    function ExecuteFrame1bpp(Data: TTETransitionData; CurrentFrame, Step,
      LastExecutedFrame: Longint; CurrentMask, PreviousMask: TBitmap; SmoothValue,
      Draw, CalcDirtyRects: Boolean): Boolean;
    procedure ExecuteFrame8bpp(Data: TTETransitionData; CurrentFrame, Step,
      LastExecutedFrame: Longint);
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, LastExecutedFrame: Longint); override;
    function  OptimizeMask: Boolean; virtual;
    function  ResetMaskBmp(Device: TTETransitionDevice): Boolean; virtual;
    function  InversePaint: Boolean; virtual;
    function  AvoidPixelRepaint: Boolean; virtual;
    function  GetInfo(Device: TTETransitionDevice): TTETransitionInfo; override;
    function  Smooth(Device: TTETransitionDevice): Boolean; virtual;
  public
    constructor Create(AOwner: TComponent = nil); override;

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

    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;
  published
    property Pass2Options;
    property PassSetting;
  end;

implementation

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

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

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.OptimizeMask: Boolean;
begin
  Result := False;
end;

function TMaskedTransition.ResetMaskBmp(Device: TTETransitionDevice): 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(Data: TTETransitionData): Integer;
begin
  if Smooth(Data.Device)
  then Result := (((Data.Width-1) div  8) + 1) *  8
  else Result := (((Data.Width-1) div 32) + 1) * 32;
end;

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

function TMaskedTransition.Smooth(Device: TTETransitionDevice): Boolean;
begin
  Result := TEProcessorInfo.MMX and (SmoothingLevel > 0) and Device.IsRGB;
end;

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

  IsSmooth := Smooth(Data.Device);
  TotalFrames := CalcTotalFrames(Data);
  TotalFramesNoSmooth := TotalFrames;
  if IsSmooth
  then
  begin
    StepLevel := LevelsArray[SmoothingLevel];
    Levels    := 255 div StepLevel;
    MaxLevel  := 254 - ((255 - (((Levels-1) * StepLevel) + 1)) div 2);
    MinLevel  := MaxLevel - ((Levels - 1) * StepLevel);

    Inc(TotalFrames, Levels-1);
    Frame8bppMaskBmp  := TBitmap.Create;
    Frame8bppMaskBmp.Canvas.Lock;
    Frame8bppMaskBmp .PixelFormat := pf8bit;
    Frame8bppMaskBmp .Palette     := CreateGrayScalePalette;
    Frame8bppMaskBmp .Width       := GetBitmapsWidth(Data);
    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.Canvas.Lock;
      Frame8bppMaskBmp2.PixelFormat := pf8bit;
      Frame8bppMaskBmp2.Palette     := CreateGrayScalePalette;
      Frame8bppMaskBmp2.Width       := Frame8bppMaskBmp.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.Canvas.Lock;
    Frame1bppMaskBmp.Width  := GetBitmapsWidth(Data);
    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.Canvas.Lock;
      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;

  if IsSmooth and not AvoidPixelRepaint and Assigned(Data.DirtyRects) then
    Data.DirtyRects.AutoClear := False;
end;

procedure TMaskedTransition.Finalize(Data: TTETransitionData);
begin
  if Assigned(Apply256MaskSProc) then
  begin
    VirtualFree(Apply256MaskSProc, 0, MEM_RELEASE);
    Apply256MaskSProc := nil;
  end;

  if Assigned(Frame1bppMaskBmp ) then
  begin
    Frame1bppMaskBmp .Canvas.Unlock;
    FreeAndNil(Frame1bppMaskBmp );
  end;
  if Assigned(Frame1bppMaskBmp2) then
  begin
    Frame1bppMaskBmp2.Canvas.Unlock;
    FreeAndNil(Frame1bppMaskBmp2);
  end;
  if Assigned(Frame8bppMaskBmp ) then
  begin
    Frame8bppMaskBmp .Canvas.Unlock;
    FreeAndNil(Frame8bppMaskBmp );
  end;
  if Assigned(Frame8bppMaskBmp2) then
  begin
    Frame8bppMaskBmp2.Canvas.Unlock;
    FreeAndNil(Frame8bppMaskBmp2);
  end;

  if(Data.PassCount = 1) or (Data.Pass = 2) 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 <= MaxSmoothingLevel 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
      RandomStyle := Random(CountOfStyles) + 1;
    Result := RandomStyle;
  end
  else Result := FStyle;
end;