teeffect.pas

这个东西的功能很强大

  MatrixSize := Width*Height;
  RandSeed := (MatrixSize);
  j := Round (MatrixSize * Percent/100);

  for i := 1 to j do
  begin
    PixelisZero := false;
    while not PixelisZero do
    begin
      RandomPosition := random (MatrixSize);
      if D^ [RandomPosition] = 0 then
      begin
        PixelisZero := true;
        D^ [RandomPosition] := $FF;
      end;
    end;
  end;

  DeltaX := Round ((Percent/100)*(Width*2-1));
  DeltaP := (0.1*Width) / Percent;
  for i := 0 to DeltaX do
    for j := 0 to Height - 1 do
      begin
        if i < Width then
          begin
            Delta := Round (Percent*2-DeltaP*i);
            if Delta < 0 then
              Delta := 0;
            Delta := Round((Delta/100)*$FF);
            if Delta > $FF then
              Delta := $FF;
            if D^ [i + j*Width] <> $0 then
              Matrix [i + j*Width] :=  Delta;
          end;
    end;

  FreeMem(D, MatrixSize);
end;

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

procedure FadeMatrixSmoothRectOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  Delta: integer;
  Center: TPoint;
  i: integer;
  DeltaP: real;
  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.6), 100);
    RealY := Height / Width;
  end
  else
  begin
    RealY := 1;
    Delta := MulDiv(Percent, Round(Height*1.6), 100);
    RealX:= Width/Height;
  end;
  Center.X := Width div 2;
  Center.Y := Height div 2;
  if (Delta div 2) = 0 then
    DeltaP := (Percent*2)
  else
    DeltaP := (Percent*2)  / (Delta div 2);

  for i := 0 to Delta div 2 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, 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;

{ Circle animations ===========================================================}

procedure FadeCircleSlideOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  delta: integer;
begin
  delta := muldiv (round(sqrt(sqr(height)+sqr(width))), percent, 100) div 2;
  for i := 0 to delta do
    FadeMatrixCircle(matrix, width, height, width div 2, height div 2, i, $FF);
end;

procedure FadeCircleFadeOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  delta: integer;
begin
  delta := muldiv (round(sqrt(sqr(height)+sqr(width))), percent, 100) div 2;
  for i := 0 to delta do
    FadeMatrixCircle (matrix, width, height, width div 2, height div 2, i, muldiv (percent, $FF, 100));
end;

procedure FadeCircleSmoothOut(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 (Round(Sqrt(Sqr(Height)+Sqr(Width))*0.9), Percent, 100);
  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;
    FadeMatrixCircle(Matrix, Width, Height, Width div 2, Height div 2, i, Alpha);
  end;
end;

procedure FadeCircleSlideIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  delta,size: integer;
begin
  delta := muldiv (round(sqrt(sqr(height)+sqr(width))), percent, 100) div 2;
  size := round(sqrt(sqr(height)+sqr(width))) div 2;
  for i := delta downto 0 do
    FadeMatrixCircle (matrix, width, height, width div 2, height div 2, size-i, $FF);
end;

procedure FadeCircleFadeIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  delta,size: integer;
begin
  delta := muldiv (round(sqrt(sqr(height)+sqr(width))), percent, 100) div 2;
  size := round(sqrt(sqr(height)+sqr(width))) div 2;
  for i := delta downto 0 do
    FadeMatrixCircle (matrix, width, height, width div 2, height div 2, size-i, muldiv (percent, $FF, 100));
end;

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

procedure FadeCircleSlide(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  Delta: integer;
begin
  Delta := muldiv (round(sqrt(sqr(Height)+sqr(Width))), Percent, 100);
  for i := Delta downto 0 do
    FadeMatrixCircle (Matrix, Width, Height, 0, Height - 1, Delta - i, $FF);
end;

procedure FadeCircleFade(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i: integer;
  Delta: integer;
begin
  Delta := muldiv (round(sqrt(sqr(Height)+sqr(Width))), Percent, 100);
  for i := Delta downto 0 do
    FadeMatrixCircle (Matrix, Width, Height, 0, Height - 1, Delta - i, muldiv (Percent, $FF, 100));
end;

procedure FadeCircleSmooth(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 (round(sqrt(sqr(Height)+sqr(Width))*1.5), 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;
    FadeMatrixCircle (Matrix, Width, Height, 0, Height - 1, i, Alpha);
  end;
end;

{ Diamond Animation ===========================================================}

procedure FadeDiamondSlideOut(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, Width, 100);
    RealY := Height/Width;
  end
  else
  begin
    RealY := 1;
    Delta := MulDiv (Percent, Height, 100);
    RealX:= Width/Height;
  end;
  Center.X := Width div 2;
  Center.Y := Height div 2;
  for i := 0 to Delta do
  begin
    Alpha := $FF;
    X := Round (RealX*i);
    Y := Round (RealY * i);
    FadeMatrixLine(Matrix, Width, Height, Center.X, Center.Y+y, Center.X-x, Center.Y, Alpha);
    FadeMatrixLine(Matrix, Width, Height, Center.X-x, Center.Y, Center.X, Center.Y-y, Alpha);
    FadeMatrixLine(Matrix, Width, Height, Center.X, Center.Y-y, Center.X+x, Center.Y, Alpha);
    FadeMatrixLine(Matrix, Width, Height, Center.X+x, Center.Y, Center.X, Center.Y+y, Alpha);
  end;
end;

procedure FadeDiamondFadeOut(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, Width, 100);
    RealY := Height/Width;
  end
  else
  begin
    RealY := 1;
    Delta := MulDiv (Percent, Height, 100);
    RealX:= Width/Height;
  end;
  Center.X := Width div 2;
  Center.Y := Height div 2;
  for i := 0 to Delta do
  begin
    Alpha := MulDiv ($FF, Percent, 100);
    X := Round (RealX*i);
    Y := Round (RealY * i);
    FadeMatrixLine (Matrix, Width, Height, Center.X, Center.Y+y, Center.X-x, Center.Y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X-x, Center.Y, Center.X, Center.Y-y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X, Center.Y-y, Center.X+x, Center.Y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X+x, Center.Y, Center.X, Center.Y+y, Alpha);
  end;
end;

procedure FadeDiamondSmoothOut(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  Delta: integer;
  Center: TPoint;
  i: integer;
  DeltaP: real;
  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*2.5), 100);
    RealY := Height/Width;
  end
  else
  begin
    RealY := 1;
    Delta := MulDiv (Percent, Round (Height*2.5), 100);
    RealX:= Width/Height;
  end;
  Center.X := Width div 2;
  Center.Y := Height div 2;
  if (Delta div 2) = 0 then
    DeltaP := (Percent*2)
  else
    DeltaP := (Percent*2)  / (Delta div 2);
  for i := 0 to Delta div 2 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, Center.X, Center.Y+y, Center.X-x, Center.Y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X-x, Center.Y, Center.X, Center.Y-y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X, Center.Y-y, Center.X+x, Center.Y, Alpha);
    FadeMatrixLine (Matrix, Width, Height, Center.X+x, Center.Y, Center.X, Center.Y+y, Alpha);
  end;
end;

procedure FadeDiamondSlideIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i,j: integer;
begin
  if Percent = 0 then
    exit;
  FadeDiamondSlideOut (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 FadeDiamondFadeIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i,j : integer;
begin
  if Percent = 0 then
    exit;
  FadeDiamondFadeOut (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] := MulDiv (Percent, $FF,100)
      else
        Matrix[i+j*Width] := 0;
end;


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

{ Other Animation =============================================================}

procedure FadePlasma(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  SinLut,CosLut: array[0..2047]of Integer;
  Colors: array[0..2047]of byte;
  i: integer;
  y,x: integer;
  a: integer;
  xx,yy: integer;
  Keys: array [0..12] of byte;
  PlasmaWidth: integer;
procedure FillColors(i1,i2,nKeys:Integer);
var
  c1,c2: byte;
  i,n,cs,w1,w2,x,ii: Integer;
begin
  i:=0;
  n:=i2-i1;
  Dec(nKeys);
  ii:=(nKeys shl 16)div n;
  for x:=0 to n-1 do
  begin
    cs:=i shr 16;
    c1:=Keys[cs];
    if cs<nKeys then Inc(cs);
    c2:=Keys[cs];
    w1:=((not i)and $FFFF)+1;
    w2:=i and $FFFF;
    if(w1<(ii-w1))
    then
       Colors[x] := c2
    else
      if (w2<(ii-w2))
      then
         Colors[x]:=c1
      else
        Colors[x]:=((c1*w1)+(c2*w2))shr 16;
    Inc(i,ii);
  end;
  Colors[x] := c2;
end;
begin
  PlasmaWidth := 512;
  for i:=0 to PlasmaWidth - 1 do
  begin
    SinLut[i]:=(Trunc(Sin(2*Pi*i/PlasmaWidth)*(PlasmaWidth div 2))+PlasmaWidth div 2)and (PlasmaWidth-1);
    CosLut[i]:=(Trunc(Cos(2*Pi*i/PlasmaWidth)*(PlasmaWidth div 2))+PlasmaWidth div 2)and (PlasmaWidth-1);
  end;
  Keys[0]:=255;
  Keys[1]:=255;
  Keys[2]:=0;
  Keys[3]:=0;
  Keys[4]:=255;
  Keys[5]:=255;
  Keys[6]:=0;
  Keys[7]:=0;
  Keys[8]:=255;
  Keys[9]:=255;
  Keys[10]:=0;
  Keys[11]:=0;
  Keys[12]:=255;
  FillColors(0,PlasmaWidth-1,13);
  for y:=0 to Height-1 do
    begin
      xx:=SinLut[(y)and (PlasmaWidth-1)];
      yy:=CosLut[(y)and (PlasmaWidth-1)];
      for x:=0 to Width-1 do
      begin
        a:=MulDiv (Percent*2,255,100)-Colors[(SinLut[(x+xx)and (PlasmaWidth-1)]+yy)and (PlasmaWidth-1)];
        if a < 0 then
          a := 0;
        if a > 255 then
          a := 255;
        Matrix [x+y*Width] := a;
      end;
    end;
end;

procedure FadeStream(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
type
  PVector = ^TVector;
  TVector = array[0..0] of Integer;
var
  i,j: Word;
  YMax: PVector;
  Yy: PVector;
begin
  GetMem (YMax, Width*Sizeof (integer));
  GetMem (Yy, Width*Sizeof (integer));