jvqpaintfx.pas

East make Tray Icon in delphi

  W := Src.Width;
  for Y := 0 to H - 1 do
  begin
    YY := Scale * Sin((Y mod Turbulence) / Scale);
    Line1 := Source.ScanLine[Y];
    for X := 0 to W - 1 do
    begin
      XX := -tan((X mod Turbulence) / Scale) / (Scale * Scale);
      XM := Round(Abs(X + XX + YY));
      YM := Round(Abs(Y + YY + XX));
      if (YM < H) and (XM < W) then
      begin
        Line2 := Dst.ScanLine[YM];
        Line2[XM] := Line1[X];
      end;
    end;
  end;
  Source.Free;
  Dst.PixelFormat := Src.PixelFormat;
end;

class procedure TJvPaintFX.Marble8(const Src: TBitmap; var Dst: TBitmap; Scale: Single;
  Turbulence: Integer);
var
  X, XM, Y, YM: Integer;
  XX, YY: Single;
  Line1, Line2: PJvRGBArray;
  W, H: Integer;
  ax: Single;
  Source: TBitmap;
begin
  if Src = nil then
    Exit;
  if Dst = nil then
    Dst := TBitmap.Create;
  Dst.Assign(Src);
  Source := TBitmap.Create;
  Source.Assign(Src);
  Dst.PixelFormat := pf24bit;
  Source.PixelFormat := pf24bit;
  H := Src.Height;
  W := Src.Width;
  for Y := 0 to H - 1 do
  begin
    ax := (Y mod Turbulence) / Scale;
    YY := Scale * Sin(ax) * Cos(1.5 * ax);
    Line1 := Source.ScanLine[Y];
    for X := 0 to W - 1 do
    begin
      ax := (X mod Turbulence) / Scale;
      XX := -Scale * Sin(2 * ax) * Cos(ax);
      XM := Round(Abs(X + XX + YY));
      YM := Round(Abs(Y + YY + XX));
      if (YM < H) and (XM < W) then
      begin
        Line2 := Dst.ScanLine[YM];
        Line2[XM] := Line1[X];
      end;
    end;
  end;
  Source.Free;
  Dst.PixelFormat := Src.PixelFormat;
end;

class procedure TJvPaintFX.Saturation(const Dst: TBitmap; Amount: Integer);
var
  Line: PJvRGBArray;
  Gray, R, G, B, X, Y: Integer;
begin
  for Y := 0 to Dst.Height - 1 do
  begin
    Line := Dst.ScanLine[Y];
    for X := 0 to Dst.Width - 1 do
    begin
      R := Line[X].rgbRed;
      G := Line[X].rgbGreen;
      B := Line[X].rgbBlue;
      Gray := (R + G + B) div 3;
      Line[X].rgbRed   := IntToByte(Gray + (((R - Gray) * Amount) div 255));
      Line[X].rgbGreen := IntToByte(Gray + (((G - Gray) * Amount) div 255));
      Line[X].rgbBlue  := IntToByte(Gray + (((B - Gray) * Amount) div 255));
    end;
  end;
end;

class procedure TJvPaintFX.Smooth(const Dst: TBitmap; Weight: Integer);
var
  Line, Line1, Line2, Line3: PJvRGBArray;
  W, H, X, Y: Integer;
  Src: TBitmap;
  OPF: TPixelFormat;
begin
  if (Dst.Height < 2) or (Dst.Width < 2) then
    Exit;
  W := Dst.Width;
  H := Dst.Height;
  Src := TBitmap.Create;
  Src.Assign(Dst);
  OPF := Dst.PixelFormat;
  Src.PixelFormat := pf24bit;
  Dst.PixelFormat := pf24bit;
  for Y := 1 to H - 2 do
  begin
    Line := Dst.ScanLine[Y];
    Line1 := Src.ScanLine[Y-1];
    Line2 := Src.ScanLine[Y];
    Line3 := Src.ScanLine[Y+1];
    Line[0].rgbRed   := (Line2[0].rgbRed   + Line2[1].rgbRed   + Line1[0].rgbRed   + Line3[0].rgbRed) div 4;
    Line[0].rgbGreen := (Line2[0].rgbGreen + Line2[1].rgbGreen + Line1[0].rgbGreen + Line3[0].rgbGreen) div 4;
    Line[0].rgbBlue  := (Line2[0].rgbBlue  + Line2[1].rgbBlue  + Line1[0].rgbBlue  + Line3[0].rgbBlue) div 4;
    Line[W-1].rgbRed   := (Line2[W-2].rgbRed   + Line2[W-1].rgbRed   + Line1[W-1].rgbRed   + Line3[W-1].rgbRed) div 4;
    Line[W-1].rgbGreen := (Line2[W-2].rgbGreen + Line2[W-1].rgbGreen + Line1[W-1].rgbGreen + Line3[W-1].rgbGreen) div 4;
    Line[W-1].rgbBlue  := (Line2[W-2].rgbBlue  + Line2[W-1].rgbBlue  + Line1[W-1].rgbBlue  + Line3[W-1].rgbBlue) div 4;
    for X := 1 to W - 2 do
    begin
      Line[X].rgbRed   := (Line2[X-1].rgbRed   + Line2[X+1].rgbRed   + Line1[X].rgbRed   + Line3[X].rgbRed) div 4;
      Line[X].rgbGreen := (Line2[X-1].rgbGreen + Line2[X+1].rgbGreen + Line1[X].rgbGreen + Line3[X].rgbGreen) div 4;
      Line[X].rgbBlue  := (Line2[X-1].rgbBlue  + Line2[X+1].rgbBlue  + Line1[X].rgbBlue  + Line3[X].rgbBlue) div 4;
    end;
  end;
  Line := Dst.ScanLine[0];
  Line1 := Src.ScanLine[0];
  Line2 := Src.ScanLine[0];
  Line3 := Src.ScanLine[1];
  for X := 1 to Dst.Width - 2 do
  begin
    Line[X].rgbRed   := (Line2[X-1].rgbRed   + Line2[X+1].rgbRed   + Line1[X].rgbRed   + Line3[X].rgbRed) div 4;
    Line[X].rgbGreen := (Line2[X-1].rgbGreen + Line2[X+1].rgbGreen + Line1[X].rgbGreen + Line3[X].rgbGreen) div 4;
    Line[X].rgbBlue  := (Line2[X-1].rgbBlue  + Line2[X+1].rgbBlue  + Line1[X].rgbBlue  + Line3[X].rgbBlue) div 4;
  end;
  Line := Dst.ScanLine[H-1];
  Line1 := Src.ScanLine[H-2];
  Line2 := Src.ScanLine[H-1];
  Line3 := Src.ScanLine[H-1];
  for X := 1 to Dst.Width - 2 do
  begin
    Line[X].rgbRed   := (Line2[X-1].rgbRed   + Line2[X+1].rgbRed   + Line1[X].rgbRed   + Line3[X].rgbRed) div 4;
    Line[X].rgbGreen := (Line2[X-1].rgbGreen + Line2[X+1].rgbGreen + Line1[X].rgbGreen + Line3[X].rgbGreen) div 4;
    Line[X].rgbBlue  := (Line2[X-1].rgbBlue  + Line2[X+1].rgbBlue  + Line1[X].rgbBlue  + Line3[X].rgbBlue) div 4;
  end;
  Src.Free;
  Dst.PixelFormat := OPF;
end;

class procedure TJvPaintFX.SmoothPoint(const Dst: TBitmap; XK, YK: Integer);
var
  Pixel: TColor;
  B, G, R: Cardinal;
begin
  if (XK > 0) and (YK > 0) and (XK < Dst.Width - 1) and (YK < Dst.Height - 1) then
    with Dst.Canvas do
    begin
      Pixel := ColorToRGB(Pixels[XK, YK - 1]);
      R := GetRValue(Pixel);
      B := GetGValue(Pixel);
      G := GetBValue(Pixel);
      Pixel := ColorToRGB(Pixels[XK + 1, YK]);
      R := R + GetRValue(Pixel);
      G := G + GetGValue(Pixel);
      B := B + GetBValue(Pixel);
      Pixel := ColorToRGB(Pixels[XK, YK + 1]);
      R := R + GetRValue(Pixel);
      G := G + GetGValue(Pixel);
      B := B + GetBValue(Pixel);
      Pixel := ColorToRGB(Pixels[XK - 1, YK]);
      R := R + GetRValue(Pixel);
      G := G + GetGValue(Pixel);
      B := B + GetBValue(Pixel);
      Pixels[XK, YK] := RGB(R div 4, G div 4, B div 4);
    end;
end;

class procedure TJvPaintFX.SmoothResize(var Src, Dst: TBitmap);
var
  X, Y, xP, yP, yP2, xP2: Integer;
  Read, Read2: PByteArray;
  T, z, z2, iz2: Integer;
  pc: PByteArray;
  w1, w2, w3, w4: Integer;
  Col1r, Col1g, Col1b, Col2r, Col2g, Col2b: Byte;
begin
  xP2 := ((Src.Width - 1) shl 15) div Dst.Width;
  yP2 := ((Src.Height - 1) shl 15) div Dst.Height;
  yP := 0;
  for Y := 0 to Dst.Height - 1 do
  begin
    xP := 0;
    Read := Src.ScanLine[yP shr 15];
    if yP shr 16 < Src.Height - 1 then
      Read2 := Src.ScanLine[yP shr 15 + 1]
    else
      Read2 := Src.ScanLine[yP shr 15];
    pc := Dst.ScanLine[Y];
    z2 := yP and $7FFF;
    iz2 := $8000 - z2;
    for X := 0 to Dst.Width - 1 do
    begin
      T := xP shr 15;
      Col1r := Read[T * bpp];
      Col1g := Read[T * bpp + 1];
      Col1b := Read[T * bpp + 2];
      Col2r := Read2[T * bpp];
      Col2g := Read2[T * bpp + 1];
      Col2b := Read2[T * bpp + 2];
      z := xP and $7FFF;
      w2 := (z * iz2) shr 15;
      w1 := iz2 - w2;
      w4 := (z * z2) shr 15;
      w3 := z2 - w4;
      pc[X * bpp + 2] :=
        (Col1b * w1 + Read[(T + 1) * bpp + 2] * w2 +
        Col2b * w3 + Read2[(T + 1) * bpp + 2] * w4) shr 15;
      pc[X * bpp + 1] :=
        (Col1g * w1 + Read[(T + 1) * bpp + 1] * w2 +
        Col2g * w3 + Read2[(T + 1) * bpp + 1] * w4) shr 15;
      pc[X * bpp] :=
        (Col1r * w1 + Read2[(T + 1) * bpp] * w2 +
        Col2r * w3 + Read2[(T + 1) * bpp] * w4) shr 15;
      Inc(xP, xP2);
    end;
    Inc(yP, yP2);
  end;
end;

class procedure TJvPaintFX.SmoothRotate(var Src, Dst: TBitmap; CX, CY: Integer;
  Angle: Single);
type
  TFColor = record
    B, G, R: Byte
  end;
var
  Top,
    Bottom,
    Left,
    Right,
    eww, nsw,
    fx, fy,
    wx, wy: Single;
  cAngle,
    sAngle: Double;
  xDiff,
    yDiff,
    ifx, ify,
    PX, PY,
    ix, iy,
    X, Y: Integer;
  nw, ne,
    sw, se: TFColor;
  P1, P2, P3: PByteArray;
begin
  Angle := Angle;
  Angle := -Angle * Pi / 180;
  sAngle := Sin(Angle);
  cAngle := Cos(Angle);
  xDiff := (Dst.Width - Src.Width) div 2;
  yDiff := (Dst.Height - Src.Height) div 2;
  for Y := 0 to Dst.Height - 1 do
  begin
    P3 := Dst.ScanLine[Y];
    PY := 2 * (Y - CY) + 1;
    for X := 0 to Dst.Width - 1 do
    begin
      PX := 2 * (X - CX) + 1;
      fx := (((PX * cAngle - PY * sAngle) - 1) / 2 + CX) - xDiff;
      fy := (((PX * sAngle + PY * cAngle) - 1) / 2 + CY) - yDiff;
      ifx := Round(fx);
      ify := Round(fy);

      if (ifx > -1) and (ifx < Src.Width) and (ify > -1) and (ify < Src.Height) then
      begin
        eww := fx - ifx;
        nsw := fy - ify;
        iy := TrimInt(ify + 1, 0, Src.Height - 1);
        ix := TrimInt(ifx + 1, 0, Src.Width - 1);
        P1 := Src.ScanLine[ify];
        P2 := Src.ScanLine[iy];
        nw.R := P1[ifx * bpp];
        nw.G := P1[ifx * bpp + 1];
        nw.B := P1[ifx * bpp + 2];
        ne.R := P1[ix * bpp];
        ne.G := P1[ix * bpp + 1];
        ne.B := P1[ix * bpp + 2];
        sw.R := P2[ifx * bpp];
        sw.G := P2[ifx * bpp + 1];
        sw.B := P2[ifx * bpp + 2];
        se.R := P2[ix * bpp];
        se.G := P2[ix * bpp + 1];
        se.B := P2[ix * bpp + 2];

        Top := nw.B + eww * (ne.B - nw.B);
        Bottom := sw.B + eww * (se.B - sw.B);
        P3[X * bpp + 2] := IntToByte(Round(Top + nsw * (Bottom - Top)));

        Top := nw.G + eww * (ne.G - nw.G);
        Bottom := sw.G + eww * (se.G - sw.G);
        P3[X * bpp + 1] := IntToByte(Round(Top + nsw * (Bottom - Top)));

        Top := nw.R + eww * (ne.R - nw.R);
        Bottom := sw.R + eww * (se.R - sw.R);
        P3[X * bpp] := IntToByte(Round(Top + nsw * (Bottom - Top)));
      end;
    end;
  end;
end;

class procedure TJvPaintFX.SplitBlur(const Dst: TBitmap; Amount: Integer);
var
  p0, P1, P2: PByteArray;
  CX, X, Y: Integer;
  Buf: array [0..3, 0..2] of Byte;
begin
  if Amount = 0 then
    Exit;
  for Y := 0 to Dst.Height - 1 do
  begin
    p0 := Dst.ScanLine[Y];
    if Y - Amount < 0 then
      P1 := Dst.ScanLine[Y]
    else {Y-Amount>0}
      P1 := Dst.ScanLine[Y - Amount];
    if Y + Amount < Dst.Height then
      P2 := Dst.ScanLine[Y + Amount]
    else {Y+Amount>=Height}
      P2 := Dst.ScanLine[Dst.Height - Y];

    for X := 0 to Dst.Width - 1 do
    begin
      if X - Amount < 0 then
        CX := X
      else {X-Amount>0}
        CX := X - Amount;
      Buf[0, 0] := P1[CX * bpp];
      Buf[0, 1] := P1[CX * bpp + 1];
      Buf[0, 2] := P1[CX * bpp + 2];
      Buf[1, 0] := P2[CX * bpp];
      Buf[1, 1] := P2[CX * bpp + 1];
      Buf[1, 2] := P2[CX * bpp + 2];
      if X + Amount < Dst.Width then
        CX := X + Amount
      else {X+Amount>=Width}
        CX := Dst.Width - X;
      Buf[2, 0] := P1[CX * bpp];
      Buf[2, 1] := P1[CX * bpp + 1];
      Buf[2, 2] := P1[CX * bpp + 2];
      Buf[3, 0] := P2[CX * bpp];
      Buf[3, 1] := P2[CX * bpp + 1];
      Buf[3, 2] := P2[CX * bpp + 2];
      p0[X * bpp] := (Buf[0, 0] + Buf[1, 0] + Buf[2, 0] + Buf[3, 0]) shr 2;
      p0[X * bpp + 1] := (Buf[0, 1] + Buf[1, 1] + Buf[2, 1] + Buf[3, 1]) shr 2;
      p0[X * bpp + 2] := (Buf[0, 2] + Buf[1, 2] + Buf[2, 2] + Buf[3, 2]) shr 2;
    end;
  end;
end;

class procedure TJvPaintFX.Spray(const Dst: TBitmap; Amount: Integer);
var
  I, J, X, Y, W, H, Val: Integer;
begin
  H := Dst.Height;
  W := Dst.Width;
  for I := 0 to W - 1 do
    for J := 0 to H - 1 do
    begin
      Val := Random(Amount);
      X := I + Val - Random(Val * 2);
      Y := J + Val - Random(Val * 2);
      if (X > -1) and (X < W) and (Y > -1) and (Y < H) then
        Dst.Canvas.Pixels[I, J] := Dst.Canvas.Pixels[X, Y];
    end;
end;

class procedure TJvPaintFX.Mosaic(const Bm: TBitmap; Size: Integer);
var
  X, Y, I, J: Integer;
  P1, P2: PJvRGBArray;
  P1Val: TJvRGBTriple;
begin
  Y := 0;
  repeat
    P1 := Bm.ScanLine[Y];
    repeat
      J := 1;
      repeat
        P2 := Bm.ScanLine[Y];
        X := 0;
        repeat
          P1Val := P1[X];
          I := 1;
          repeat
            P2[X] := P1Val;
            Inc(X);
            Inc(I);
          until (I > Size) or (X >= Bm.Width);
        until X >= Bm.Width;
        Inc(J);
        Inc(Y);
      until (J > Size) or (Y >= Bm.Height);
    until (Y >= Bm.Height) or (X >= Bm.Width);
  until Y >= Bm.Height;
end;

class procedure TJvPaintFX.Twist(var Bmp, Dst: TBitmap; Amount: Integer);
var
  fxmid, fymid: Single;
  txmid, tymid: Single;
  fx, fy: Single;
  tx2, ty2: Single;
  R: Single;
  theta: Single;
  ifx, ify: Integer;
  DX, DY: Single;
  OFFSET: Single;
  ty, tx: Integer;
  WeightX, WeightY: array [0..1] of Single;
  Weight: Single;
  new_red, new_green: Integer;
  new_blue: Integer;
  total_red, total_green: Single;
  total_blue: Single;
  ix, iy: Integer;
  sli, slo: PByteArray;

  function ArcTan2(xt, yt: Single): Single;
  begin
    if xt = 0 then
      if yt > 0 then
        Result := Pi / 2
      else
        Result := -(Pi / 2)
    else
    begin
      Result := ArcTan(yt / xt);
      if xt < 0 then
        Result := Pi + ArcTan(yt / xt);
    end;
  end;

begin
  OFFSET := -(Pi / 2);
  DX := Bmp.Width - 1;
  DY := Bmp.Height - 1;
  R := Sqrt(DX * DX + DY * DY);
  tx2 := R;
  ty2 := R;