pseffect.pas

TPicShow是一套图形平滑特效控制组件

    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);