pseffect.pas

免费控件PicShow的最新版本

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 }

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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, 48, X, N);
end;

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, 48, W - X - N, N);
end;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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;

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,
         Image.Canvas.Handle, 0, H - mY,
         SRCCOPY);
end;

procedure Effect030(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  mY, mH: Integer;
begin
  mY := Y div 2;
  mH := H div 2;
  StretchBlt(Display.Canvas.Handle, 0, 0, W, mY,
             Image.Canvas.Handle, 0, 0, W, mH,
             SRCCOPY);
  StretchBlt(Display.Canvas.Handle, 0, H - mY, W, mY,
             Image.Canvas.Handle, 0, mH, W, mH,
             SRCCOPY);
end;

procedure Effect031(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  N: Integer;
begin
  N := H div 10;
  if N > Y then
    N := Y
  else if 2 * N > H - Y then
    N := (H - Y) div 2;
  StretchBlt(Display.Canvas.Handle, 0, Y + N - 1, W, -N,
             Image.Canvas.Handle, 0, Y + N, W, N,
             SRCCOPY);
  BitBlt(Display.Canvas.Handle, 0, 0, W, Y,
         Image.Canvas.Handle, 0, 0,
         SRCCOPY);
  ApplyVReflect(Display, 48, Y, N);
end;

procedure Effect032(Display, Image: TBitmap; W, H, X, Y, Progress: Integer);
var
  N: Integer;