teeffect.pas

这个东西的功能很强大

function TteProcList.GetProcs(Index: string): TteProcItem;
var
  i: integer;
  S: string;
begin
  { Equal }
  for i := 0 to Count - 1 do
  begin
    if LowerCase(TteProcItem(Items[i]).Name) = LowerCase(Index) then
    begin
      Result := TteProcItem(Items[i]);
      Exit;
    end;
  end;

  {  }
  for i := 0 to Count - 1 do
  begin
    S := LowerCase(TteProcItem(Items[i]).Name);
    if Pos(SFade, S) > 0 then System.Delete(S, 1, Pos('-', S)+1);
    if Pos(SSlide, S) > 0 then System.Delete(S, 1, Pos('-', S)+1);
    if Pos(SManual, S) > 0 then System.Delete(S, 1, Pos('-', S)+1);

    if S = LowerCase(Index) then
    begin
      Result := TteProcItem(Items[i]);
      Exit;
    end;
  end;

  Result := nil;
end;

{ FadeMatrix routines }

procedure FadeMatrixLine(var Matrix: TteMatrixFade; Width, Height: integer; x1, y1, x2, y2: integer; Alpha: byte);
var
  i, dx, dy, Plotx, Ploty, ix, iy, max, x, y: integer;
  Plot: boolean;
begin
  dx := x2 - x1;
  dy := y2 - y1;
  ix := abs (dx);
  iy := abs (dy);
  if ix > iy then
    max := ix
  else
    max := iy;
  Plotx := x1;
  Ploty := y1;
  x := 0;
  y := 0;
  if (Plotx >= 0) and (Ploty >= 0) and (Plotx < Width) and (Ploty < Height) then
    Matrix [Plotx + Width*Ploty] := Alpha;
  for i := 0 to max do
  begin
    x := x + ix;
    y := y + iy;
    Plot := false;
    if x > max then
    begin
       Plot := true;
       x := x - max;
       if dx > 0 then
         inc (Plotx)
       else
         dec (Plotx);
    end;
    if y > max then
    begin
       Plot := true;
       y := y - max;
       if dy > 0 then
         inc (Ploty)
       else
         dec (Ploty);
     end;
     if (Plot) and (Plotx >= 0) and (Ploty >= 0) and (Plotx < Width) and (Ploty < Height) then
       Matrix[Plotx + Width*Ploty] := Alpha;
   end;
end;

procedure FadeMatrixCircle(var Matrix: TteMatrixFade; Width, Height: integer; xc, yc, radius: integer; Alpha: byte);
var
  x, y, d: integer;
  Ratio: real;
 procedure Symmetry(x, y, xc, yc : integer);
 procedure SetMatrixpixel(xp, yp : integer);
 begin
   if (xp >= 0) and (xp < width) and (yp>=0) and (yp < Height) then
     Matrix [xp + Width*yp] := Alpha;
 end;
var
  x_start, x_end, x_out : integer;
  y_start, y_end, y_out : integer;
begin
  x_start := round (x * Ratio);
  x_end := round ((x+1) * Ratio);
  y_start := round (y * Ratio);
  y_end := round ((y+1) * Ratio);
  for x_out := x_start to x_end do
  begin
    setmatrixpixel(x_out + xc, y + yc);
    setmatrixpixel(x_out + xc, -y + yc);
    setmatrixpixel(-x_out + xc,-y + yc);
    setmatrixpixel(-x_out + xc,y + yc);
  end;
  for y_out := y_start to y_end do
  begin
    setmatrixpixel(y_out + xc, x + yc);
    setmatrixpixel(y_out + xc, -x + yc);
    setmatrixpixel(-y_out + xc, -x + yc);
    setmatrixpixel(-y_out + xc, x + yc);
  end;
end;
begin
  ratio := 1;
  y := Radius;
  d := 3 - 2 * Radius;
  x := 0;
  while x < y do
  begin
    symmetry (x, y, xc, yc);
    if d < 0 then
      d := d + 4*x + 6
    else
    begin
      d := d + 4*(x-y) + 10;
      dec (y);
    end;
    inc (x);
  end;
  if x = y then
    symmetry (x, y, xc, yc);
end;

{ FadeMatrix's Effects ========================================================}

procedure FadeMatrixFade(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  Value: Byte;
begin
  if Percent = 0 then Exit;

  Value := Round($FF * (Percent / 100));

  FillChar(Matrix, Width * Height, Value);
end;

procedure FadeMatrixDiagonal(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, MulDiv(Percent,$FF,100));
      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, MulDiv(Percent,$FF,100));
      if x < DeltaX then
        Inc(x);
    end;
  end;
end;

procedure FadeMatrixDiagonalIn(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, MulDiv(Percent,$FF,100));
      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, MulDiv(Percent,$FF,100));
      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, MulDiv(Percent,$FF,100));
      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, MulDiv(Percent,$FF,100));
      if x > Width - 1 - DeltaX then
        Dec (x);
    end;
  end;
end;

procedure FadeMatrixDiagonalOut(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, MulDiv(Percent,$FF,100));
      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, MulDiv(Percent,$FF,100));
      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, MulDiv(Percent,$FF,100));
      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, MulDiv(Percent,$FF,100));
      if x < DeltaX then
        Inc (x);
    end;
  end;
end;

procedure FadeMatrixDown(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, MulDiv(Percent,$FF,100));
end;

procedure FadeMatrixIn(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, MulDiv(Percent,$FF,100));
  for j := 0 to MulDiv(Percent,Height div 2,100) do
    FadeMatrixLine (Matrix, Width, Height, 0, j, Width-1, j, MulDiv(Percent,$FF,100));
end;

procedure FadeMatrixOut(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, MulDiv(Percent,$FF,100));
    FadeMatrixLine (Matrix, Width, Height, 0, Height div 2 + j, Width-1, Height div 2 + j, MulDiv(Percent,$FF,100));
  end;
end;

procedure FadeMatrixCrossOut(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, MulDiv (Percent, $FF,100));
  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, MulDiv (Percent, $FF,100));
end;

procedure FadeMatrixCrossIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i,j: integer;
begin
  if Percent = 0 then
    exit;
  FadeMatrixCrossOut (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 FadeMatrixRectOut(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 := MulDiv ($FF, Percent, 100);
    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 FadeMatrixRectIn(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  i,j: integer;
begin
  if Percent = 0 then
    exit;
  FadeMatrixRectOut (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;

{ Pixel Effects ==============================================================}

procedure FadeMatrixPixel(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  MatrixSize: Cardinal;
  i, j: cardinal;
  PixelisZero: boolean;
  RandomPosition: Cardinal;
begin
  if percent = 0 then Exit;

  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 Matrix [RandomPosition] = 0 then
      begin
        PixelisZero := true;
        Matrix[RandomPosition] := $FF;
      end;
    end;
  end;
end;

procedure FadeMatrixPixelFade(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  MatrixSize: Cardinal;
  i, j: cardinal;
  PixelisZero: boolean;
  RandomPosition: Cardinal;
begin
  if percent = 0 then
    exit;
  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 matrix [RandomPosition] = 0 then
      begin
        PixelisZero := true;
        matrix [RandomPosition] := Round((Percent/100)*$FF);
      end;
    end;
  end;
end;

procedure FadeMatrixPixelLine(var Matrix: TteMatrixFade; Width, Height: integer; Percent: byte);
var
  D: PteMatrixFade;
  MatrixSize: Cardinal;
  i, j: cardinal;
  PixelisZero: boolean;
  RandomPosition: Cardinal;
  DeltaX, Delta: Integer;
  DeltaP: Real;
begin
  if percent = 0 then
    exit;

  GetMem(D, Width * Height);
  FillChar(D^, Width*Height, 0);