teeffect.pas

这个东西的功能很强大

  RandSeed := Width*Height;
  for i:=0 to Width - 1 do
  begin
    yy^ [i]:=-Random(80);
    YMax^ [i]:=Height - 1;
  end;
  for j:=1 to 8 do
    for I:=j to Width-1-j do
      yy^ [i]:=(yy^[i-1] + yy^[i]*2 + yy^[i+1]) div 4;

  for i:=0 to MulDiv (Height+79, Percent, 100) do
  begin
    for j:=0 to Width-1 do
    begin
      if yy^ [j] <= YMax^ [j] then
      begin
        if yy^ [j] >= 0 then
          Matrix [j + Width*yy^[j]] := $FF;
        Inc (yy^ [j]);
      end
      else
      begin
        yy^ [j] := 0;
        Dec (YMax^ [j]);
      end;
    end;
  end;
  FreeMem (YMax);
  FreeMem (Yy);
end;

{ Rotate Effects ==============================================================}

procedure FadeRotateSlide(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  size: integer;
begin
  if percent = 0 then
    exit;

  size := MulDiv (height + width, percent, 100);
  for i := 0 to size do
  begin
    if i < Height then
      FadeMatrixLine(Matrix, Width, Height, 0, height-1, Width-1, height-i, $FF)
    else
      FadeMatrixLine(Matrix, Width, Height, 0, height-1, width-(size-i), 0, $FF);
  end;
end;

procedure FadeRotateFade(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  size: integer;
begin
  if percent = 0 then
    exit;

  size := MulDiv (height + width, percent, 100);
  for i := 0 to size do
  begin
    if i < Height then
      FadeMatrixLine (Matrix, Width, Height, 0, height-1, Width-1, height-i, MulDiv (Percent, $FF, 100))
    else
      FadeMatrixLine (Matrix, Width, Height, 0, height-1, width-(size-i), 0, MulDiv (Percent, $FF, 100));
  end;
end;

procedure FadeRotateSmooth(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  Delta: integer;
  Deltap: real;
  Alpha: Integer;
begin
  if percent = 0 then
    exit;

  Delta := MulDiv ((Height + Width)*2, percent, 100);
  DeltaP := (Percent*2)  / Delta;
  for i := 0 to Delta do
  begin
    Alpha := MulDiv (Round(Percent*2-i*DeltaP), $FF, 100);
    if Alpha > $FF then
      Alpha := $FF;
    if Percent = 100 then
      Alpha := $FF;
    if i < Height then
      FadeMatrixLine (Matrix, Width, Height, 0, height-1, Width-1, height-i, Alpha)
    else
      FadeMatrixLine (Matrix, Width, Height, 0, height-1, width-(i-height), 0, Alpha);
  end;
end;

{ Slide Effects ===============================================================}

procedure FadeSlideDiagonal(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  DeltaX, DeltaY: integer;
  x, y: integer;
begin

  if percent = 0 then
    exit;

  DeltaX := MulDiv ((Width-1), Percent, 100) * 2;
  DeltaY := MulDiv ((Height-1), Percent, 100) * 2;

  if DeltaX > DeltaY then
  begin
    y := 0;
    for x := 0 to DeltaX do
    begin
      FadeMatrixLine(Matrix, Width, Height, 0, y, x, 0, $FF);
      if y < DeltaY then
        Inc (y);
    end;
  end
  else
  begin
    x := 0;
    for y := 0 to DeltaY do
    begin
      FadeMatrixLine(Matrix, Width, Height, 0, y, x, 0, $FF);
      if x < DeltaX then
        Inc(x);
    end;
  end;
end;

procedure FadeSlideDiagonalIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  DeltaX, DeltaY: integer;
  x, y: integer;
begin

  if percent = 0 then
    exit;

  DeltaX := Round ((Percent/100)*(Width-1));
  DeltaY := Round ((Percent/100)*(Height-1));

  if DeltaX > DeltaY then
  begin
    y := 0;
    for x := 0 to DeltaX do
    begin
      FadeMatrixLine(Matrix, Width, Height, 0, Height-y-1, x, Height-1, $FF);
      if y < DeltaY then
        Inc (y);
    end;
    y := 0;
    for x := Width - 1 downto Width - DeltaX - 1 do
    begin
      FadeMatrixLine(Matrix, Width, Height, x, 0, width-1, y, $FF);
      if y < DeltaY then
        Inc (y);
    end;
  end
  else
  begin
    x := 0;
    for y := 0 to DeltaY do
    begin
      FadeMatrixLine(Matrix, Width, Height, 0, Height-y-1, x, Height-1, $FF);
      if x < DeltaX then
        Inc (x);
    end;
    x := Width - 1;
    for y := 0 to DeltaY do
    begin
      FadeMatrixLine(Matrix, Width, Height, x, 0, Width-1, y, $FF);
      if x > Width - 1 - DeltaX then
        Dec (x);
    end;
  end;
end;

procedure FadeSlideDiagonalOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  DeltaX, DeltaY: integer;
  x, y: integer;
begin
  if percent = 0 then
    exit;
  DeltaX := Round ((Percent/100)*(Width-1));
  DeltaY := Round ((Percent/100)*(Height-1));
  if DeltaX > DeltaY then
  begin
    y := 0;
    for x := 0 to DeltaX do
    begin
      FadeMatrixLine (Matrix, Width, Height, 0, Y, Width - x -1, Height - 1, $FF);
      if y < DeltaY then
        Inc (y);
    end;
    y := 0;
    for x := 0 to DeltaX do
    begin
      FadeMatrixLine (Matrix, Width, Height, x, 0, Width, Height - y, $FF);
      if y < DeltaY then
        Inc (y);
    end;
  end
  else
  begin
    x := 0;
    for y := 0 to DeltaY do
    begin
      FadeMatrixLine (Matrix, Width, Height, x, 0, Width - 1, Height - y -1, $FF);
      if x < DeltaX then
        Inc (x);
    end;
    x := 0;
    for y := 0 to DeltaY do
    begin
      FadeMatrixLine (Matrix, Width, Height, 0, y, Width-x-1, height-1, $FF);
      if x < DeltaX then
        Inc (x);
    end;
  end;
end;

procedure FadeSlideDown(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  j: integer;
begin
  if percent = 0 then
    exit;
  for j := 0 to MulDiv(Percent,Height-1,100) do
    FadeMatrixLine (Matrix, Width, Height, 0, j, Width-1, j, $FF);
end;

procedure FadeSlideIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  j: integer;
begin
  if percent = 0 then
    exit;
  for j := Height-1 downto Height - 1 - MulDiv(Percent,Height div 2,100) do
    FadeMatrixLine (Matrix, Width, Height, 0, j, Width-1, j, $FF);
  for j := 0 to MulDiv(Percent,Height div 2,100) do
    FadeMatrixLine (Matrix, Width, Height, 0, j, Width-1, j, $FF);
end;

procedure FadeSlideOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  j: integer;
begin
  if percent = 0 then
    exit;
  for j := 0 to MulDiv(Percent,Height div 2,100) do
  begin
    FadeMatrixLine (Matrix, Width, Height, 0, Height div 2 - j, Width-1, Height div 2 - j, $FF);
    FadeMatrixLine (Matrix, Width, Height, 0, Height div 2 + j, Width-1, Height div 2 + j, $FF);
  end;
end;

procedure FadeSlideCrossOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  DeltaX, DeltaY: integer;
  Center: TPoint;
  i: integer;
begin
  if Percent = 0 then
    exit;
  DeltaX := MulDiv (Percent, Width*2, 100);
  DeltaY := MulDiv (Percent, Height*2, 100);
  Center.X := Width div 2;
  Center.Y := Height div 2;
  for i := -DeltaX div 4 to DeltaX div 4 do
    FadeMatrixLine (Matrix, Width, Height, Center.X+i, Center.Y-DeltaY,Center.X+i, Center.Y+DeltaY, $FF);
  for i := -DeltaY div 4 to DeltaY div 4 do
    FadeMatrixLine (Matrix, Width, Height, Center.X-DeltaX, Center.Y+i,Center.X+DeltaX, Center.Y+i, $FF);
end;

procedure FadeSlideCrossIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i,j: integer;
begin
  if Percent = 0 then
    exit;
  FadeSlideCrossOut (Matrix, Width, Height, 100-Percent);
  for i := 0 to Width-1 do
    for j := 0 to Height-1 do
      if Matrix[i+j*Width] = 0
      then
        Matrix[i+j*Width] := $FF
      else
        Matrix[i+j*Width] := 0;
end;

procedure FadeSlideRectOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  Delta: integer;
  Center: TPoint;
  i: integer;
  Alpha: integer;
  RealX,RealY: Real;
  x,y: integer;
begin
  if Percent = 0 then
    exit;
  if Width > Height then
  begin
    RealX := 1;
    Delta := MulDiv (Percent, Round (Width*1), 100);
    RealY := Height/Width;
  end
  else
  begin
    RealY := 1;
    Delta := MulDiv (Percent, Round (Height*1), 100);
    RealX:= Width/Height;
  end;
  Center.X := Width div 2;
  Center.Y := Height div 2;
  for i := 0 to Delta div 2 do
  begin
    Alpha := $FF;
    X := Round (RealX*i);
    Y := Round (RealY * i);
    FadeMatrixLine (Matrix, Width, Height, Center.X-x, Center.Y+y,Center.X-x, Center.Y-y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X-x, Center.Y-y,Center.X+x, Center.Y-y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X+x, Center.Y-y,Center.X+x, Center.Y+y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X+x, Center.Y+y,Center.X-x, Center.Y+y, Alpha);
  end;
end;

procedure FadeSlideRectIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i,j: integer;
begin
  if Percent = 0 then
    exit;
  FadeSlideRectOut (Matrix, Width, Height, 100-Percent);
  for i := 0 to Width-1 do
    for j := 0 to Height-1 do
      if Matrix[i+j*Width] = 0
      then
        Matrix[i+j*Width] := $FF
      else
        Matrix[i+j*Width] := 0;
end;

{ Smooth Effects ==============================================================}

procedure FadeSmoothDiagonal(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  Delta: integer;
  DeltaP: Real;
  x, y, i: integer;
  RealX,RealY: Real;
  Alpha: integer;
begin

  if Percent = 0 then
    exit;

  if Width > Height then
  begin
    RealX := 1;
    Delta := MulDiv (Percent, Round(Sqrt(Sqr(Height)+Sqr(Width))*2.5), 100);
    RealY := Height/Width;
  end
  else
  begin
    RealY := 1;
    Delta := MulDiv (Percent, Round(Sqrt(Sqr(Height)+Sqr(Width))*2.5), 100);
    RealX:= Width/Height;
  end;
  if Delta = 0 then
    DeltaP := (Percent*2)
  else
    DeltaP := (Percent*2)  / Delta;

  for i := 0 to Delta do
  begin
    Alpha := MulDiv (Round(Percent*2-i*DeltaP), $FF, 100);
    if Alpha > $FF then
      Alpha := $FF;
    if Percent = 100 then
      Alpha := $FF;
    x := Round (RealX*i);
    y := Round (RealY * i);
    FadeMatrixLine (Matrix, Width, Height, 0, y, x, 0, Alpha);
  end;
end;

procedure FadeSmoothDown(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  Delta: Integer;
  DeltaP: Real;
  j: Integer;
  Alpha: integer;
begin
  if Percent = 0 then
    exit;
  Delta := MulDiv (Round(Height*1.5), Percent, 100);
  if Delta = 0 then
    DeltaP := (Percent*2)
  else
    DeltaP := (Percent*2)  / Delta;
  for j := 0 to Delta do
  begin
    Alpha := MulDiv (Round(Percent*2-j*DeltaP), $FF, 100);
    if Alpha > $FF then
      Alpha := $FF;
    if Percent = 100 then
      Alpha := $FF;
    FadeMatrixLine (Matrix, Width, Height, 0, j, Width-1, j, Alpha);
  end;
end;

procedure FadeSmoothIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  Delta: Integer;
  DeltaP: Real;
  j: Integer;
  Alpha: integer;
begin
  if Percent = 0 then
    exit;
  Delta := MulDiv (Round(Height*0.8), Percent, 100);
  if Delta = 0 then
    DeltaP := (Percent*2)
  else
    DeltaP := (Percent*2)  / Delta;
  for j := 0 to Delta do
  begin
    Alpha := MulDiv (Round(Percent*2-j*DeltaP), $FF, 100);
    if Alpha > $FF then
      Alpha := $FF;
    if Percent = 100 then
      Alpha := $FF;
    if j <= Height div 2 then
    begin
      FadeMatrixLine (Matrix, Width, Height, 0, Height-j-1, Width-1, Height-j-1, Alpha);
      FadeMatrixLine (Matrix, Width, Height, 0, j, Width-1, j, Alpha);
    end;
  end;
end;

procedure FadeSmoothOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  Delta: Integer;
  DeltaP: Real;
  j: Integer;
  Alpha: integer;
begin
  if Percent = 0 then
    exit;
  Delta := MulDiv (Round(Height*0.8), Percent, 100);
  if Delta = 0 then
    DeltaP := (Percent*2)
  else
    DeltaP := (Percent*2)  / Delta;
  for j := 0 to Delta do
  begin
    Alpha := MulDiv (Round(Percent*2-j*DeltaP), $FF, 100);
    if Alpha > $FF then
      Alpha := $FF;
    if Percent = 100 then
      Alpha := $FF;
    if j <= Height div 2 then
    begin
      FadeMatrixLine (Matrix, Width, Height, 0, Height div 2 - j, Width-1, Height div 2 - j, Alpha);
      Fad