pseffect.pas

这个Delphi控件可以将你的静态图片以多种特效的效果显示出来

        Inc(X1, S);
      end;
    end;
    Result := ComplexRegion.CreateRegion;
  finally
    ComplexRegion.Free;
  end;
end;

function CreateSliceRgn(mX, mY, Radius: Integer; StartAngle, EndAngle: Extended;
  NumPts: Integer): HRGN;
var
  Pts, Pt: PPoint;
  Sin, Cos, Delta: Extended;
  I: Integer;
begin
  GetMem(Pts, (NumPts + 1) * SizeOf(TPoint));
  try
    Pt := Pts;
    Pt.X := mX;
    Pt.Y := mY;
    Delta := (EndAngle - StartAngle) / NumPts;
    for I := 1 to NumPts do
    begin
      Inc(Pt);
      SinCos(StartAngle, Sin, Cos);
      Pt.X := mX + Round(Radius * Cos);
      Pt.Y := mY + Round(Radius * Sin);
      StartAngle := StartAngle + Delta;
    end;
    Result := CreatePolygonRgn(Pts^, NumPts + 1, WINDING);
  finally
    FreeMem(Pts);
  end;
end;

function CreatePolygonRgnEx(const Pts: array of Integer): HRGN;
begin
  Result := CreatePolygonRgn(Pts, (High(Pts) - Low(Pts) + 1) shr 1, WINDING);
end;

{ Transition Effects }

// Expand from right
procedure Effect001(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, W - X, 0, X, H,
             Image.Canvas.Handle, 0, 0, W, H,
             SRCCOPY);
end;

// Expand from left
procedure Effect002(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, 0, 0, X, H,
             Image.Canvas.Handle, 0, 0, W, H,
             SRCCOPY);
end;

// Slide in from right
procedure Effect003(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  BitBlt(Display.Canvas.Handle, W - X, 0, W, H,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
end;

// Slide in from left
procedure Effect004(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  BitBlt(Display.Canvas.Handle, X - W, 0, W, H,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
end;

// Reveal from left
procedure Effect005(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  BitBlt(Display.Canvas.Handle, 0, 0, X, H,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
end;

// Reveal from right
procedure Effect006(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  BitBlt(Display.Canvas.Handle, W - X, 0, X, H,
         Image.Canvas.Handle, W - X, 0,
         SRCCOPY);
end;

// Expand in from right
procedure Effect007(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, 0, 0, (2 * W) - X, H,
             Image.Canvas.Handle, 0, 0, X, H,
             SRCCOPY);
end;

// Expand in from left
procedure Effect008(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, X - W, 0, (2 * W) - X, H,
             Image.Canvas.Handle, W - X, 0, X, H,
             SRCCOPY);
end;

// Expand in to middle
procedure Effect009(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, X - W, 0, (3 * W) - (2 * X), H,
             Image.Canvas.Handle, (W - X) div 2, 0, X, H,
             SRCCOPY);
end;

// Expand out from middle
procedure Effect010(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, (W - X) div 2, 0, X, H,
             Image.Canvas.Handle, 0, 0, W, H,
             SRCCOPY);
end;

// Reveal out from middle
procedure Effect011(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  mWX: Integer;
begin
  mWX := (W - X) div 2;
  BitBlt(Display.Canvas.Handle, mWX, 0, X, H,
         Image.Canvas.Handle, mWX, 0,
         SRCCOPY);
end;

// Reveal in from sides
procedure Effect012(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  mX: Integer;
begin
  mX := X div 2;
  BitBlt(Display.Canvas.Handle, 0, 0, mX, H,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
  BitBlt(Display.Canvas.Handle, W - mX, 0, mX, H,
         Image.Canvas.Handle, W - mX, 0,
         SRCCOPY);
end;

// Expand in from sides
procedure Effect013(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  mX, mW: Integer;
begin
  mX := X div 2;
  mW := W div 2;
  StretchBlt(Display.Canvas.Handle, 0, 0, mX, H,
             Image.Canvas.Handle, 0, 0, mW, H,
             SRCCOPY);
  StretchBlt(Display.Canvas.Handle, W - mX, 0, mX, H,
             Image.Canvas.Handle, mW, 0, mW, H,
             SRCCOPY);
end;

// Unroll from left
procedure Effect014(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  N: Integer;
begin
  N := W div 10;
  if N > X then
    N := X
  else if 2 * N > W - X then
    N := (W - X) div 2;
  StretchBlt(Display.Canvas.Handle, X + N - 1, 0, -N, H,
             Image.Canvas.Handle, X + N, 0, N, H,
             SRCCOPY);
  BitBlt(Display.Canvas.Handle, 0, 0, X, H,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
  ApplyHReflect(Display, 64, X, N);
end;

// Unroll from right
procedure Effect015(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  N: Integer;
begin
  N := W div 10;
  if N > X then
    N := X
  else if 2 * N > W - X then
    N := (W - X) div 2;
  StretchBlt(Display.Canvas.Handle, W - X - 1, 0, -N, H,
             Image.Canvas.Handle, W - X - 2 * N - 1, 0, N, H,
             SRCCOPY);
  BitBlt(Display.Canvas.Handle, W - X, 0, X, H,
         Image.Canvas.Handle, W - X, 0,
         SRCCOPY);
  ApplyHReflect(Display, 64, W - X - N, N);
end;

// Build up from right
procedure Effect016(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  N: Integer;
begin
  BitBlt(Display.Canvas.Handle, 0, 0, X, H,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
  N := Min(W - X, W div 10);
  StretchBlt(Display.Canvas.Handle, X, 0, W - X, H,
             Image.Canvas.Handle, X, 0, N, H,
             SRCCOPY);
end;

// Build up from left
procedure Effect017(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  N: Integer;
begin
  BitBlt(Display.Canvas.Handle, W - X, 0, X, H,
         Image.Canvas.Handle, W - X, 0,
         SRCCOPY);
  N := Max((W - X) - (W div 10), 0);
  StretchBlt(Display.Canvas.Handle, 0, 0, W - X, H,
             Image.Canvas.Handle, N, 0, W - X - N, H,
             SRCCOPY);
end;

// Expand from bottom
procedure Effect018(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, 0, H - Y, W, Y,
             Image.Canvas.Handle, 0, 0, W, H,
             SRCCOPY);
end;

// Expand from top
procedure Effect019(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, 0, 0, W, Y,
             Image.Canvas.Handle, 0, 0, W, H,
             SRCCOPY);
end;

// Slide in from bottom
procedure Effect020(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  BitBlt(Display.Canvas.Handle, 0, H - Y, W, H,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
end;

// Slide in from top
procedure Effect021(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  BitBlt(Display.Canvas.Handle, 0, Y - H, W, H,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
end;

// Reveal from top
procedure Effect022(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  BitBlt(Display.Canvas.Handle, 0, 0, W, Y,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
end;

// Reveal from bottom
procedure Effect023(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  BitBlt(Display.Canvas.Handle, 0, H - Y, W, Y,
         Image.Canvas.Handle, 0, H - Y,
         SRCCOPY);
end;

// Expand in from bottom
procedure Effect024(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, 0, 0, W, (2 * H) - Y,
             Image.Canvas.Handle, 0, 0, W, Y,
             SRCCOPY);
end;

// Expand in from top
procedure Effect025(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, 0, Y - H, W, (2 * H) - Y,
             Image.Canvas.Handle, 0, H - Y, W, Y,
             SRCCOPY);
end;

// Expand in to middle (horiz)
procedure Effect026(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, 0, Y - H, W, (3 * H) - (2 * Y),
             Image.Canvas.Handle, 0, (H - Y) div 2, W, Y,
             SRCCOPY);
end;

// Expand out from middle (horiz)
procedure Effect027(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
begin
  StretchBlt(Display.Canvas.Handle, 0, (H - Y) div 2, W, Y,
             Image.Canvas.Handle, 0, 0, W, H,
             SRCCOPY);
end;

// Reveal from middle (horiz)
procedure Effect028(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  mHY: Integer;
begin
  mHY := (H - Y) div 2;
  BitBlt(Display.Canvas.Handle, 0, mHY, W, Y,
         Image.Canvas.Handle, 0, mHY,
         SRCCOPY);
end;

// Slide in from top / bottom
procedure Effect029(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  mY: Integer;
begin
  mY := Y div 2;
  BitBlt(Display.Canvas.Handle, 0, 0, W, mY,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
  BitBlt(Display.Canvas.Handle, 0, H - mY, W, mY,