📄 pseffect.pas
字号:
(Name: 'Unroll from left'; Proc: Effect014),
(Name: 'Unroll from right'; Proc: Effect015),
(Name: 'Build up from right'; Proc: Effect016),
(Name: 'Build up from left'; Proc: Effect017),
(Name: 'Expand from bottom'; Proc: Effect018),
(Name: 'Expand from top'; Proc: Effect019),
(Name: 'Slide in from bottom'; Proc: Effect020),
(Name: 'Slide in from top'; Proc: Effect021),
(Name: 'Reveal from top'; Proc: Effect022),
(Name: 'Reveal from bottom'; Proc: Effect023),
(Name: 'Expand in from bottom'; Proc: Effect024),
(Name: 'Expand in from top'; Proc: Effect025),
(Name: 'Expand in to middle (horiz)'; Proc: Effect026),
(Name: 'Expand out from middle (horiz)'; Proc: Effect027),
(Name: 'Reveal from middle (horiz)'; Proc: Effect028),
(Name: 'Slide in from top / bottom'; Proc: Effect029),
(Name: 'Expand in from top / bottom'; Proc: Effect030),
(Name: 'Unroll from top'; Proc: Effect031),
(Name: 'Unroll from bottom'; Proc: Effect032),
(Name: 'Expand from bottom'; Proc: Effect033),
(Name: 'Expand in from top'; Proc: Effect034),
(Name: 'Expand from bottom right'; Proc: Effect035),
(Name: 'Expand from top right'; Proc: Effect036),
(Name: 'Expand from top left'; Proc: Effect037),
(Name: 'Expand from bottom left'; Proc: Effect038),
(Name: 'Slide in from bottom right'; Proc: Effect039),
(Name: 'Slide in from top right'; Proc: Effect040),
(Name: 'Slide in from top left'; Proc: Effect041),
(Name: 'Slide in from bottom left'; Proc: Effect042),
(Name: 'Reveal from top left'; Proc: Effect043),
(Name: 'Reveal from bottom left'; Proc: Effect044),
(Name: 'Reveal from bottom right'; Proc: Effect045),
(Name: 'Reveal from top right'; Proc: Effect046),
(Name: 'Appear and Contract to top left'; Proc: Effect047),
(Name: 'Appear and Contract to bottom left'; Proc: Effect048),
(Name: 'Appear and Contract to bottom right'; Proc: Effect049),
(Name: 'Appear and Contract to top right'; Proc: Effect050),
(Name: 'Appear and Contract to middle'; Proc: Effect051),
(Name: 'Expand out from centre'; Proc: Effect052),
(Name: 'Reveal out from centre'; Proc: Effect053),
(Name: 'Reveal in to centre'; Proc: Effect054),
(Name: 'Quarters Reveal in to middle'; Proc: Effect055),
(Name: 'Quarters Expand to middle'; Proc: Effect056),
(Name: 'Quarters Slide in to middle'; Proc: Effect057),
(Name: 'Curved Reveal from left'; Proc: Effect058),
(Name: 'Curved Reveal from right'; Proc: Effect059),
(Name: 'Bars in from right'; Proc: Effect060),
(Name: 'Bars in from left'; Proc: Effect061),
(Name: 'Bars left then right'; Proc: Effect062),
(Name: 'Bars right then left'; Proc: Effect063),
(Name: 'Bars from both sides'; Proc: Effect064),
(Name: 'Uneven shred from right'; Proc: Effect065),
(Name: 'Uneven shred from left'; Proc: Effect066),
(Name: 'Uneven shred out from middle (horiz)'; Proc: Effect067),
(Name: 'Uneven shred in to middle (horiz)'; Proc: Effect068),
(Name: 'Curved Reveal from top'; Proc: Effect069),
(Name: 'Curved Reveal from bottom'; Proc: Effect070),
(Name: 'Bars from bottom'; Proc: Effect071),
(Name: 'Bars from top'; Proc: Effect072),
(Name: 'Bars top then bottom'; Proc: Effect073),
(Name: 'Bars bottom then top'; Proc: Effect074),
(Name: 'Bars from top and bottom'; Proc: Effect075),
(Name: 'Unven shred from bottom'; Proc: Effect076),
(Name: 'Uneven shred from top'; Proc: Effect077),
(Name: 'Uneven shred from horizon'; Proc: Effect078),
(Name: 'Uneven shred in to horizon'; Proc: Effect079),
(Name: 'Curved reveal from top left'; Proc: Effect080),
(Name: 'Curved reveal from top right'; Proc: Effect081),
(Name: 'Curved reveal from bottom left'; Proc: Effect082),
(Name: 'Curved reveal from bottom right'; Proc: Effect083),
(Name: 'Circular reveal from centre'; Proc: Effect084),
(Name: 'Circular reveal to centre'; Proc: Effect085),
(Name: 'Criss Cross reveal from bottom right'; Proc: Effect086),
(Name: 'Criss Cross reveal from top right'; Proc: Effect087),
(Name: 'Criss Cross reveal from bottom left'; Proc: Effect088),
(Name: 'Criss Cross reveal from top left'; Proc: Effect089),
(Name: 'Criss Cross reveal bounce from top left'; Proc: Effect090),
(Name: 'Criss Cross reveal bounce from bottom left'; Proc: Effect091),
(Name: 'Criss Cross reveal bounce from top right'; Proc: Effect092),
(Name: 'Criss Cross reveal bounce from bottom right'; Proc: Effect093),
(Name: 'Criss Cross reveal from right top and bottom'; Proc: Effect094),
(Name: 'Criss Cross reveal from left top and bottom'; Proc: Effect095),
(Name: 'Criss Cross reveal from left right and bottom'; Proc: Effect096),
(Name: 'Criss Cross reveal from left right and top'; Proc: Effect097),
(Name: 'Criss Cross reveal from top left right and bottom'; Proc: Effect098),
(Name: 'Criss Cross reveal from bottom left top right'; Proc: Effect099),
(Name: 'Uneven shred from bottom and right'; Proc: Effect100),
(Name: 'Uneven shred from top and right'; Proc: Effect101),
(Name: 'Uneven shred from bottom and left'; Proc: Effect102),
(Name: 'Uneven shred from top and left'; Proc: Effect103),
(Name: 'Uneven shred from horiz and right'; Proc: Effect104),
(Name: 'Uneven shred from horiz and left'; Proc: Effect105),
(Name: 'Uneven shred from bottom and vert middle'; Proc: Effect106),
(Name: 'Uneven shred from top and vert middle'; Proc: Effect107),
(Name: 'Uneven shred from centre'; Proc: Effect108),
(Name: 'Uneven shred to centre'; Proc: Effect109),
(Name: 'Reveal diagonal from top left'; Proc: Effect110),
(Name: 'Reveal diagonal from top right'; Proc: Effect111),
(Name: 'Reveal diagonal from bottom left'; Proc: Effect112),
(Name: 'Reveal diagonal from bottom right'; Proc: Effect113),
(Name: 'Diagonal sweep from top left bottom right anticlockwise'; Proc: Effect114),
(Name: 'Diagonal sweep from top left bottom right clockwise'; Proc: Effect115),
(Name: 'Starburst clockwise from center'; Proc: Effect116),
(Name: 'Triangular shred to top left'; Proc: Effect117),
(Name: 'Fade'; Proc: Effect118),
(Name: 'Pivot from top left'; Proc: Effect119),
(Name: 'Pivot from bottom left'; Proc: Effect120),
(Name: 'Pivot from top right'; Proc: Effect121),
(Name: 'Pivot from bottom right'; Proc: Effect122),
(Name: 'Speckle appear from right'; Proc: Effect123),
(Name: 'Speckle appear from left'; Proc: Effect124),
(Name: 'Speckle appear from bottom'; Proc: Effect125),
(Name: 'Speckle appear from top'; Proc: Effect126),
(Name: 'Random squares appear'; Proc: Effect127),
(Name: 'Push right'; Proc: Effect128),
(Name: 'Push left'; Proc: Effect129),
(Name: 'Push and squeeze right'; Proc: Effect130),
(Name: 'Push and squeeze left'; Proc: Effect131),
(Name: 'Push down'; Proc: Effect132),
(Name: 'Push up'; Proc: Effect133),
(Name: 'Push and sqeeze down'; Proc: Effect134),
(Name: 'Push and sqeeze up'; Proc: Effect135),
(Name: 'Blind vertically'; Proc: Effect136),
(Name: 'Blind horizontally'; Proc: Effect137),
(Name: 'Uneven blind from left'; Proc: Effect138),
(Name: 'Uneven blind from right'; Proc: Effect139),
(Name: 'Uneven blind from top'; Proc: Effect140),
(Name: 'Uneven blind from bottom'; Proc: Effect141),
(Name: 'Rectangular shred'; Proc: Effect142),
(Name: 'Sweep clockwise'; Proc: Effect143),
(Name: 'Sweep anticlockwise'; Proc: Effect144),
(Name: 'Rectangles apear from left and disapear to right'; Proc: Effect145),
(Name: 'Rectangles apear from right and disapear to left'; Proc: Effect146),
(Name: 'Rectangles apear from up and disapear to bottom'; Proc: Effect147),
(Name: 'Rectangles apear from bottom and disapear to up'; Proc: Effect148),
(Name: 'Rotational rectangle'; Proc: Effect149),
(Name: 'Rotational star'; Proc: Effect150));
procedure MirrorCopyRect(Canvas: TCanvas; dstRect: TRect; Bitmap: TBitmap; srcRect: TRect; Horz, Vert: Boolean);
procedure MergeTransparent(dstBitmap, srcBitmap: TBitmap; Transparency: Integer);
procedure MergeRotate(dstBitmap, srcBitmap: TBitmap; xOrg, yOrg: Integer; Angle: Extended);
procedure RotatePoints(var Points: array of TPoint; xOrg, yOrg: Integer; Angle: Extended);
implementation
uses
Math;
const
MaxPixelCount = 32768;
type
PRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = array[0..MaxPixelCount] of TRGBQuad;
{$IFNDEF DELPHI4_UP}
HRGN = THandle;
{$ENDIF}
{ Global Functions }
procedure MirrorCopyRect(Canvas: TCanvas; dstRect: TRect;
Bitmap: TBitmap; srcRect: TRect; Horz, Vert: Boolean);
var
T: Integer;
begin
IntersectRect(srcRect, srcRect, Rect(0, 0, Bitmap.Width, Bitmap.Height));
if Horz then
begin
T := dstRect.Left;
dstRect.Left := dstRect.Right+1;
dstRect.Right := T-1;
end;
if Vert then
begin
T := dstRect.Top;
dstRect.Top := dstRect.Bottom+1;
dstRect.Bottom := T-1;
end;
StretchBlt(Canvas.Handle, dstRect.Left, dstRect.Top,
dstRect.Right - dstRect.Left, dstRect.Bottom - dstRect.Top,
Bitmap.Canvas.Handle, srcRect.Left, srcRect.Top,
srcRect.Right - srcRect.Left, srcRect.Bottom - srcRect.Top, SRCCOPY);
end;
// Both bitmaps must be equal size and 32 bit format.
procedure MergeTransparent(dstBitmap, srcBitmap: TBitmap; Transparency: Integer);
var
dstPixel, srcPixel: PRGBQuad;
InvertTransparency: Integer;
bmpWidth, bmpHeight: Integer;
x, y: Integer;
begin
bmpWidth := srcBitmap.Width;
bmpHeight := srcBitmap.Height;
InvertTransparency := 100 - Transparency;
for y := 0 to bmpHeight - 1 do
begin
srcPixel := srcBitmap.ScanLine[y];
dstPixel := dstBitmap.ScanLine[y];
for x := 0 to bmpWidth - 1 do
begin
dstPixel^.rgbRed := ((InvertTransparency * dstPixel^.rgbRed) +
(Transparency * srcPixel^.rgbRed)) div 100;
dstPixel^.rgbGreen := ((InvertTransparency * dstPixel^.rgbGreen) +
(Transparency * srcPixel^.rgbGreen)) div 100;
dstPixel^.rgbBlue := ((InvertTransparency * dstPixel^.rgbBlue) +
(Transparency * srcPixel^.rgbBlue)) div 100;
Inc(srcPixel);
Inc(dstPixel);
end;
end;
end;
// Both bitmaps must be equal size and 32 bit format. Angle is in radians.
procedure MergeRotate(dstBitmap, srcBitmap: TBitmap; xOrg, yOrg: Integer;
Angle: Extended);
var
CosTheta, SinTheta: Extended;
iCosTheta, iSinTheta: Integer;
xSrc, ySrc: Integer;
xDst, yDst: Integer;
xPrime, yPrime: Integer;
bmpWidth, bmpHeight: Integer;
yPrimeSinTheta, yPrimeCosTheta: Integer;
srcBits: PRGBQuadArray;
dstBits: PRGBQuad;
begin
SinCos(-Angle, SinTheta, CosTheta);
iSinTheta := Trunc(SinTheta * (1 shl 16));
iCosTheta := Trunc(CosTheta * (1 shl 16));
bmpWidth := srcBitmap.Width;
bmpHeight := srcBitmap.Height;
srcBits := srcBitmap.ScanLine[bmpHeight-1];
dstBits := @(PRGBQuadArray(dstBitmap.ScanLine[0])[bmpWidth-1]);
yPrime := bmpHeight - yOrg;
for yDst := bmpHeight - 1 downto 0 do
begin
yPrimeSinTheta := yPrime * iSinTheta;
yPrimeCosTheta := yPrime * iCosTheta;
xPrime := bmpWidth - xOrg;
for xDst := bmpWidth - 1 downto 0 do
begin
xSrc := SmallInt((xPrime * iCosTheta - yPrimeSinTheta) shr 16) + xOrg;
ySrc := SmallInt((xPrime * iSinTheta + yPrimeCosTheta) shr 16) + yOrg;
{$IFDEF DELPHI4_UP}
if (DWORD(ySrc) < DWORD(bmpHeight)) and (DWORD(xSrc) < DWORD(bmpWidth)) then
{$ELSE} // Delphi 3 compiler ignores unsigned type cast and generates signed comparison code!
if (ySrc >= 0) and (ySrc < bmpHeight) and (xSrc >= 0) and (xSrc < bmpWidth) then
{$ENDIF}
begin
dstBits^ := srcBits[ySrc * bmpWidth + xSrc];
end;
Dec(dstBits);
Dec(xPrime);
end;
Dec(yPrime);
end;
end;
// Angle is in radians.
procedure RotatePoints(var Points: array of TPoint; xOrg, yOrg: Integer;
Angle: Extended);
var
Sin, Cos: Extended;
xPrime, yPrime: Integer;
I: Integer;
begin
SinCos(Angle, Sin, Cos);
for I := Low(Points) to High(Points) do
begin
xPrime := Points[I].X - xOrg;
yPrime := Points[I].Y - yOrg;
Points[I].X := Round(xPrime * Cos - yPrime * Sin) + xOrg;
Points[I].Y := Round(xPrime * Sin + yPrime * Cos) + yOrg;
end;
end;
{ Helper Functions }
function CreateBarRgn(X, Y, W, H, S: Integer; XMode, YMode: Integer): HRGN;
var
X1, Y1: Integer;
Rgn, tRgn: HRGN;
begin
Result := 0;
if X <= W then Y1 := 0 else Y1 := 5;
while Y1 < H + 5 do
begin
if X > W then
begin
if XMode in [1, 4] then
tRgn := CreateRectRgn(2 * W - X, Y1, W, Y1 + 5)
else if XMode in [2, 5] then
tRgn := CreateRectRgn(0, Y1, X - W, Y1 + 5)
else
tRgn := 0;
Rgn := CreateRectRgn(0, Y1 - 5, W, Y1);
if tRgn <> 0 then
begin
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
end
else
begin
if (X + S) > W then X := W;
if XMode in [1, 5] then
Rgn := CreateRectRgn(W - X, Y1, W, Y1 + 5)
else if XMode in [2, 4] then
Rgn := CreateRectRgn(0, Y1, X, Y1 + 5)
else if XMode = 3 then
begin
Rgn := CreateRectRgn(0, Y1 + 5, X, Y1 + 10);
tRgn := CreateRectRgn(W - X, Y1, W, Y1 + 5);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end
else
Rgn := 0;
end;
if Result <> 0 then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(Y1, 10)
end;
if Y <= H then X1 := 0 else X1 := 5;
while X1 < W + 5 do
begin
if Y > H then
begin
if YMode in [1, 4] then
tRgn := CreateRectRgn(X1, 2 * H - Y, X1 + 5, H)
else if YMode in [2, 5] then
tRgn := CreateRectRgn(X1, 0, X1 + 5, Y - H)
else
tRgn := 0;
Rgn := CreateRectRgn(X1 - 5, 0, X1, H);
if tRgn <> 0 then
begin
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
end
else
begin
if (Y + S) > H then Y := H;
if YMode in [1, 5] then
Rgn := CreateRectRgn(X1, H - Y, X1 + 5, H)
else if YMode in [2, 4] then
Rgn := CreateRectRgn(X1, 0, X1 + 5, Y)
else if YMode = 3 then
begin
tRgn := CreateRectRgn(X1, H - Y, X1 + 5, H);
Rgn := CreateRectRgn(X1 + 5, 0, X1 + 10, Y);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end
else
Rgn := 0;
end;
if Rgn <> 0 then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -