📄 tepixelt.pas
字号:
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 + -