⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tepixelt.pas

📁 delphi2007界面效果控件源码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit tePixelt;

interface

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

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

type
  TPixelateTransition = class(TTimedTransitionEffect)
  private
    FBoxSize: Word;
    procedure DoPrecomputation(Data: TTETransitionData; Bmp: TBitmap);
    procedure PaintPixelate(Work: PByteArray;
      ScanLineSize, RowGap, Width, Height, Box: Integer; BGR: PDWordArray);
    procedure Paint2x2Pixelate(Work: PByteArray; ScanLineSize, RowGap, Width,
      Height: Integer; BGR: PDWordArray);
    procedure SetBoxSize(const Value: Word);
  protected
    BoxSizeToUse: Integer;

    procedure Initialize(Data: TTETransitionData; var Frames: Longint); override;
    function  CalcTotalFrames(Data: TTETransitionData): Longint;
    function  GetPixelFormat(Device: TTETransitionDevice): TPixelFormat; override;
    procedure ExecuteFrame(Data: TTETransitionData;
      CurrentFrame, Step, LastExecutedFrame: Longint); override;
    procedure PixelateBmp(Bitmap: TBitmap; Data: TTETransitionData;
      Box: Integer);
    function GetInfo(Device: TTETransitionDevice): TTETransitionInfo; override;
  public
    constructor Create(AOwner: TComponent = nil); override;
    procedure Assign(Source: TPersistent); override;
    function GetDelegate(Device: TTETransitionDevice;
      const ReturnCopy: Boolean): TTransitionEffect; override;
    class function Description: String; override;
    class function GetEditor: String; override;
  published
    property Pass2Options;
    property PassSetting;
    property BoxSize: Word read FBoxSize write SetBoxSize;
    property Reversed;
  end;

implementation

uses teFuse;

type
  TPixelateData = class(TTECustomData)
  public
    BGRImg: PDWordArray;
    BGRImgRowSize: Integer;
    Pass1: Boolean;
    Pass2Frame: Integer;

    destructor Destroy; override;
  end;

{ TPixelateTransition }

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

  FBoxSize := 50;
end;

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

    BoxSize := TPixelateTransition(Source).BoxSize;
  end
  else inherited;
end;

function TPixelateTransition.CalcTotalFrames(Data: TTETransitionData): Longint;
begin
  BoxSizeToUse := FBoxSize;
  if Data.Width < BoxSizeToUse then
    BoxSizeToUse := Data.Width;
  if Data.Height < BoxSizeToUse then
    BoxSizeToUse := Data.Height;
  Result := (BoxSizeToUse * 2) - 1;
end;

class function TPixelateTransition.Description: String;
begin
  Result := 'Pixelate';
end;

function TPixelateTransition.GetPixelFormat(Device: TTETransitionDevice):
  TPixelFormat;
begin
  Result := pf24bit;
end;

procedure TPixelateTransition.Initialize(Data: TTETransitionData;
  var Frames: Integer);
var
  PixelateData: TPixelateData;
begin
  inherited;

  PixelateData := TPixelateData.Create(Data);
  Data.Custom  := PixelateData;
  Frames := CalcTotalFrames(Data);
  PixelateData.Pass2Frame    := (Frames div 2) + 1;
  PixelateData.BGRImgRowSize := Data.Width * 3;
  GetMem(PixelateData.BGRImg, Data.Height * (PixelateData.BGRImgRowSize * 4));

  DoPrecomputation(Data, Data.SrcBmp);
  PixelateData.Pass1 := True;
end;

procedure TPixelateTransition.DoPrecomputation(Data: TTETransitionData;
  Bmp: TBitmap);
var
  x,
  y,
  IndexWork,
  Index: Integer;
  Work: PByteArray;
  PixelateData: TPixelateData;
begin
  PixelateData := TPixelateData(Data.Custom);
  Index := 0;
  Work  := nil;
	for y := 0 to Data.Height - 1 do
  begin
    IndexWork := 0;
    if y >= 0 then
      Work := PByteArray(PChar(Bmp.ScanLine[Data.Height-y-1]));
    for x := 0 to Data.Width - 1 do
    begin
      if(x > 0) and (y > 0)
      then
      begin
        PixelateData.BGRImg[Index] :=
          Work[IndexWork]                                         +
          PixelateData.BGRImg[Index-3                           ] +
          PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize  ] -
          PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize-3];
        Inc(Index);
        PixelateData.BGRImg[Index] :=
          Work[IndexWork+1]                                       +
          PixelateData.BGRImg[Index-3                           ] +
          PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize  ] -
          PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize-3];
        Inc(Index);
        PixelateData.BGRImg[Index] :=
          Work[IndexWork+2]                                       +
          PixelateData.BGRImg[Index-3                           ] +
          PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize  ] -
          PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize-3];
        Inc(Index);
        Inc(IndexWork, 3);
      end
      else
      begin
        if x = 0
        then
        begin
          if y > 0
          then
          begin
            PixelateData.BGRImg[Index] :=
              Work[IndexWork  ] +
              PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize];
            Inc(Index);
            PixelateData.BGRImg[Index] :=
              Work[IndexWork+1] +
              PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize];
            Inc(Index);
            PixelateData.BGRImg[Index] :=
              Work[IndexWork+2] +
              PixelateData.BGRImg[Index-PixelateData.BGRImgRowSize];
            Inc(Index);
            Inc(IndexWork, 3);
          end
          else
          begin
            PixelateData.BGRImg[Index  ] := Work[IndexWork  ];
            PixelateData.BGRImg[Index+1] := Work[IndexWork+2];
            PixelateData.BGRImg[Index+2] := Work[IndexWork+3];
            Inc(Index    , 3);
            Inc(IndexWork, 3);
          end;
        end
        else
        begin
          PixelateData.BGRImg[Index  ] :=
            Work[IndexWork  ] +
            PixelateData.BGRImg[Index-3];
          PixelateData.BGRImg[Index+1] :=
            Work[IndexWork+1] +
            PixelateData.BGRImg[Index-2];
          PixelateData.BGRImg[Index+2] :=
            Work[IndexWork+2] +
            PixelateData.BGRImg[Index-1];
          Inc(Index,     3);
          Inc(IndexWork, 3);
        end;
      end;
    end;
  end;
end;

procedure TPixelateTransition.ExecuteFrame(Data: TTETransitionData;
  CurrentFrame, Step, LastExecutedFrame: Integer);
var
  PixelateData: TPixelateData;
begin
  PixelateData := TPixelateData(Data.Custom);
  if CurrentFrame < PixelateData.Pass2Frame
  then PixelateBmp(Data.Bitmap, Data, CurrentFrame + 1)
  else
  begin
    if PixelateData.Pass1 then
    begin
      PixelateData.Pass1 := False;
      DoPrecomputation(Data, Data.DstBmp);
    end;
    PixelateBmp(Data.Bitmap, Data, Data.Frames - CurrentFrame + 1);
  end;
  Data.UpdateRect := Rect(0, 0, Data.Width, Data.Height);
end;

procedure TPixelateTransition.PixelateBmp(Bitmap: TBitmap; Data: TTETransitionData;
  Box: Integer);
var
  ScanLineSize: Integer;
  Work : PChar;
  UpdParams: TTEUpdParams;
  PixelateData: TPixelateData;
begin
  PixelateData := TPixelateData(Data.Custom);
  ScanLineSize := GetBytesPerScanline(Bitmap, Bitmap.PixelFormat, 32);
  GiveMeTheUpdParams(2, UpdParams, ScanLineSize,
    Rect(0, 0, Data.Width, Data.Height), Rect(0, 0, 0, 0), Bitmap.PixelFormat);
  Work         := PChar(Bitmap.ScanLine[Data.Height-1]);

  if Box > 2
  then PaintPixelate(
         PByteArray(Work),
         ScanLineSize,
         UpdParams.GapBytes1,
         Data.Width,
         Data.Height,
         Box,
         PixelateData.BGRImg)
  else Paint2x2Pixelate(
         PByteArray(Work),
         ScanLineSize,
         UpdParams.GapBytes1,
         Data.Width,
         Data.Height,
         PixelateData.BGRImg);
end;

function TPixelateTransition.GetDelegate(Device: TTETransitionDevice;
  const ReturnCopy: Boolean): TTransitionEffect;
var
  Transition: TTransitionEffect;
begin
  Result := nil;
  if Device.IsRGB
  then Result := inherited GetDelegate(Device, ReturnCopy)
  else
  begin
    Transition := TFuseTransition.Create(nil);
    try
      Transition.Assign(Self);
      TFuseTransition(Transition).Style := 1;
      Result := Transition.GetDelegate(Device, False);
      if Result <> Transition then
        Transition.Free;
    finally
      if Result <> Transition then
        Transition.Free;
    end;
  end;
end;

procedure TPixelateTransition.SetBoxSize(const Value: Word);
begin
  if(Value >= 1) then
    FBoxSize := Value;
end;

class function TPixelateTransition.GetEditor: String;
begin
  Result := 'TPixelateTransitionEditor';
end;

function TPixelateTransition.GetInfo(Device: TTETransitionDevice):
  TTETransitionInfo;
begin
  Result := inherited GetInfo(Device) +
    [
      tetiMillisecondsCapable,
      tetiNeedOffScreenBmp,
      tetiOffScreenBmpCapable,
      tetiThreadSafe
    ];
end;

procedure TPixelateTransition.PaintPixelate(Work: PByteArray;
  ScanLineSize, RowGap, Width, Height, Box: Integer; BGR: PDWordArray);
var
  BoxPixels: Cardinal;
  WIndex,
  aux,
  ColLenght,
  ColsLenght,
  RowsLimit,
  PixelsBytes,
  ColLimit,
  ColsLimit,
  RowLimit,
  BoxLimit,
  LastColAdjust,
  NextColOffset,
  NextRowOffset,
  BytesToEnd,
  CopyRows: Integer;
  BValue,
  GValue,
  RValue: Byte;
  NotFirst,
  FirstCol,
  FirstRow: Boolean;
begin
  NotFirst      := False;
  FirstRow      := True;
  FirstCol      := True;
  WIndex        := 0;
  ColLenght     := Box * 3;
  ColsLenght    := ColLenght * (Width div Box);
  RowsLimit     := ScanLineSize * (Height div Box) * Box;
  BoxPixels     := Box * Box;
  PixelsBytes   := Width * 3;
  aux           := Width * 3 * Box;
  NextColOffset := Box * 12;
  NextRowOffset := (Box - 1) * Width * 12;
  CopyRows      := Box - 1;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -