?? pseffect.pas
字號:
begin
if Result <> 0 then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
end;
Inc(X1, 10)
end;
end;
function CreatePourRgn(X, Y, W, H, XMode, YMode: Integer): HRGN;
var
X1, Y1, N: Integer;
Rgn, tRgn: HRGN;
begin
Result := 0;
if XMode <> 0 then
begin
if X < W then
N := W div 7
else
N := 0;
Y1 := 0;
while Y1 < H do
begin
if XMode = 1 then
Rgn := CreateRectRgn(W - X + Random(N) - Random(N), Y1, W, Y1 + 5 + H mod 5)
else if XMode = 2 then
Rgn := CreateRectRgn(0, Y1, X + Random(N) - Random(N), Y1 + 5 + H mod 5)
else if XMode = 3 then
begin
Rgn := CreateRectRgn((W - X + Random(N) - Random(N)) div 2, Y1, W div 2, Y1 + 5 + H mod 5);
tRgn := CreateRectRgn(W div 2, Y1, (W + X + Random(N) - Random(N)) div 2, Y1 + 5 + H mod 5);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end
else
begin
Rgn := CreateRectRgn(W - (X + Random(N) - Random(N)) div 2, Y1, W, Y1 + 5 + H mod 5);
tRgn := CreateRectRgn(0, Y1, (X + Random(N) - Random(N)) div 2, Y1 + 5 + H mod 5);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
if Result <> 0 then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(Y1, 5);
end;
end;
if YMode <> 0 then
begin
if Y < H then
N := H div 7
else
N := 0;
X1 := 0;
while X1 < W do
begin
if YMode = 1 then
Rgn := CreateRectRgn(X1, H - Y + Random(N) - Random(N), X1 + 5 + W mod 5, H)
else if YMode = 2 then
Rgn := CreateRectRgn(X1, 0, X1 + 5 + W mod 5, Y + Random(N) - Random(N))
else if YMode = 3 then
begin
Rgn := CreateRectRgn(X1, (H - Y + Random(N) - Random(N)) div 2, X1 + 5 + W mod 5, H div 2);
tRgn := CreateRectRgn(X1, H div 2, X1 + 5 + W mod 5, (H + Y + Random(N) - Random(N)) div 2);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end
else
begin
Rgn := CreateRectRgn(X1, H - (Y + Random(N) - Random(N)) div 2, X1 + 5 + W mod 5, H);
tRgn := CreateRectRgn(X1, 0, X1 + 5 + W mod 5, (Y + Random(N) - Random(N)) div 2);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
if Result <> 0 then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(X1, 5);
end;
end;
end;
function CreateSwarmRgn(X, Y, W, H, XMode, YMode: Integer): HRGN;
var
X1, Y1, N, M, I, J: Integer;
Rgn, tRgn: HRGN;
begin
Result := 0;
if XMode <> 0 then
begin
if X < W then
N := W div 10
else
N := 0;
M := N div 20;
if M < 2 then M := 2;
Y1 := 0;
while Y1 < H do
begin
if XMode = 1 then
begin
Rgn := CreateRectRgn(W - X, Y1, W, Y1 + M);
for I := N div M downto 1 do
begin
if I > 3 * N div M div 4 then J := 0 else J := 1;
if Random(I) <= J then
begin
X1 := (W - X) - (I * M);
tRgn := CreateRectRgn(X1, Y1, X1 + M, Y1 + M);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
end;
end
else
begin
Rgn := CreateRectRgn(0, Y1, X, Y1 + M);
for I := N div M downto 1 do
begin
if I > 3 * N div M div 4 then J := 0 else J := 1;
if Random(I) <= J then
begin
X1 := X + (I * M);
tRgn := CreateRectRgn(X1 - M, Y1, X1, Y1 + M);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
end;
end;
if Result <> 0 then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(Y1, M div 2);
end;
end;
if YMode <> 0 then
begin
if Y < H then
N := H div 10
else
N := 0;
M := N div 20;
if M < 2 then M := 2;
X1 := 0;
while X1 < W do
begin
if YMode = 1 then
begin
Rgn := CreateRectRgn(X1, H - Y, X1 + M, H);
for I := N div M downto 1 do
begin
if I > 3 * N div M div 4 then J := 0 else J := 1;
if Random(I) <= J then
begin
Y1 := (H - Y) - (I * M);
tRgn := CreateRectRgn(X1, Y1, X1 + M, Y1 + M);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
end;
end
else
begin
Rgn := CreateRectRgn(X1, 0, X1 + M, Y);
for I := N div M downto 1 do
begin
if I > 3 * N div M div 4 then J := 0 else J := 1;
if Random(I) <= J then
begin
Y1 := Y + (I * M);
tRgn := CreateRectRgn(X1, Y1 - M, X1 + M, Y1);
CombineRgn(Rgn, Rgn, tRgn, RGN_OR);
DeleteObject(tRgn);
end;
end;
end;
if Result <> 0 then
begin
CombineRgn(Result, Result, Rgn, RGN_OR);
DeleteObject(Rgn);
end
else
Result := Rgn;
Inc(X1, M div 2);
end;
end;
end;
function CreateTriangleRgn(X1, Y1, X2, Y2, X3, Y3: Integer): HRGN;
var
Pts: array[1..3] of TPoint;
begin
Pts[1].X := X1;
Pts[1].Y := Y1;
Pts[2].X := X2;
Pts[2].Y := Y2;
Pts[3].X := X3;
Pts[3].Y := Y3;
Result := CreatePolygonRgn(Pts, High(Pts), WINDING);
end;
function CreateArcRgn(mX, mY, Radius: Integer; StartAngle, EndAngle: Extended;
NumPts: Integer): HRGN;
type
PtArray = array[0..0] of TPoint;
var
Pts: ^PtArray;
Sin, Cos, Delta: Extended;
I: Integer;
begin
GetMem(Pts, (NumPts + 1) * SizeOf(TPoint));
try
Pts[0].X := mX;
Pts[0].Y := mY;
Delta := (EndAngle - StartAngle) / NumPts;
for I := 1 to NumPts do
begin
SinCos(StartAngle, Sin, Cos);
Pts[I].X := mX + Round(Radius * Cos);
Pts[I].Y := mY + Round(Radius * Sin);
StartAngle := StartAngle + Delta;
end;
Result := CreatePolygonRgn(Pts^, NumPts + 1, WINDING);
finally
FreeMem(Pts);
end;
end;
procedure CalcParams(const Rect: TRect; Step: Integer; Progress: Integer;
var W, H, X, Y, Slice: Integer);
begin
W := Rect.Right - Rect.Left;
H := Rect.Bottom - Rect.Top;
if W >= H then
begin
X := MulDiv(W, Progress, 100);
Y := MulDiv(X, H, W);
Slice := MulDiv(W, Step, 90);
end
else
begin
Y := MulDiv(H, Progress, 100);
X := MulDiv(Y, W, H);
Slice := MulDiv(H, Step, 90);
end;
end;
{$IFNDEF DELPHI4_UP}
function Min(A, B: Integer): Integer;
begin
if A < B then
Result := A
else
Result := B;
end;
{$ENDIF}
{$IFNDEF DELPHI4_UP}
function Max(A, B: Integer): Integer;
begin
if A > B then
Result := A
else
Result := B;
end;
{$ENDIF}
{ Transition Effects }
procedure Effect001(Screen, Image: TBitmap; const Rect: TRect;
Step: Integer; Progress: Integer);
var
W, H, X, Y, S: Integer;
R: TRect;
begin
CalcParams(Rect, Step, Progress, W, H, X, Y, S);
R := Rect;
R.Left := W - X;
Screen.Canvas.CopyRect(R, Image.Canvas, Rect);
end;
procedure Effect002(Screen, Image: TBitmap; const Rect: TRect;
Step: Integer; Progress: Integer);
var
W, H, X, Y, S: Integer;
R: TRect;
begin
CalcParams(Rect, Step, Progress, W, H, X, Y, S);
R := Rect;
R.Right := X;
Screen.Canvas.CopyRect(R, Image.Canvas, Rect);
end;
procedure Effect003(Screen, Image: TBitmap; const Rect: TRect;
Step: Integer; Progress: Integer);
var
W, H, X, Y, S: Integer;
R: TRect;
begin
CalcParams(Rect, Step, Progress, W, H, X, Y, S);
R := Rect;
R.Left := W - X;
R.Right := (2 * W) - X;
Screen.Canvas.CopyRect(R, Image.Canvas, Rect);
end;
procedure Effect004(Screen, Image: TBitmap; const Rect: TRect;
Step: Integer; Progress: Integer);
var
W, H, X, Y, S: Integer;
R: TRect;
begin
CalcParams(Rect, Step, Progress, W, H, X, Y, S);
R := Rect;
R.Left := X - W;
R.Right := X;
Screen.Canvas.CopyRect(R, Image.Canvas, Rect);
end;
procedure Effect005(Screen, Image: TBitmap; const Rect: TRect;
Step: Integer; Progress: Integer);
var
W, H, X, Y, S: Integer;
R1, R2: TRect;
begin
CalcParams(Rect, Step, Progress, W, H, X, Y, S);
R1 := Rect;
R2 := Rect;
R1.Right := X;
R2.Right := X;
Screen.Canvas.CopyRect(R1, Image.Canvas, R2);
end;
procedure Effect006(Screen, Image: TBitmap; const Rect: TRect;
Step: Integer; Progress: Integer);
var
W, H, X, Y, S: Integer;
R1, R2: TRect;
begin
CalcParams(Rect, Step, Progress, W, H, X, Y, S);
R1 := Rect;
R2 := Rect;
R1.Left := W - X;
R2.Left := W - X;
Screen.Canvas.CopyRect(R1, Image.Canvas, R2);
end;
procedure Effect007(Screen, Image: TBitmap; const Rect: TRect;
Step: Integer; Progress: Integer);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -