jvqpaintfx.pas

East make Tray Icon in delphi

  txmid := (Bmp.Width - 1) / 2; //Adjust these to move center of rotation
  tymid := (Bmp.Height - 1) / 2; //Adjust these to move ......
  fxmid := (Bmp.Width - 1) / 2;
  fymid := (Bmp.Height - 1) / 2;
  if tx2 >= Bmp.Width then
    tx2 := Bmp.Width - 1;
  if ty2 >= Bmp.Height then
    ty2 := Bmp.Height - 1;

  for ty := 0 to Round(ty2) do
  begin
    for tx := 0 to Round(tx2) do
    begin
      DX := tx - txmid;
      DY := ty - tymid;
      R := Sqrt(DX * DX + DY * DY);
      if R = 0 then
      begin
        fx := 0;
        fy := 0;
      end
      else
      begin
        theta := ArcTan2(DX, DY) - R / Amount - OFFSET;
        fx := R * Cos(theta);
        fy := R * Sin(theta);
      end;
      fx := fx + fxmid;
      fy := fy + fymid;

      ify := Trunc(fy);
      ifx := Trunc(fx);
      // Calculate the weights.
      if fy >= 0 then
      begin
        WeightY[1] := fy - ify;
        WeightY[0] := 1 - WeightY[1];
      end
      else
      begin
        WeightY[0] := -(fy - ify);
        WeightY[1] := 1 - WeightY[0];
      end;
      if fx >= 0 then
      begin
        WeightX[1] := fx - ifx;
        WeightX[0] := 1 - WeightX[1];
      end
      else
      begin
        WeightX[0] := -(fx - ifx);
        WeightX[1] := 1 - WeightX[0];
      end;

      if ifx < 0 then
        ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width)
      else
      if ifx > Bmp.Width - 1 then
        ifx := ifx mod Bmp.Width;
      if ify < 0 then
        ify := Bmp.Height - 1 - (-ify mod Bmp.Height)
      else
      if ify > Bmp.Height - 1 then
        ify := ify mod Bmp.Height;

      total_red := 0.0;
      total_green := 0.0;
      total_blue := 0.0;
      for ix := 0 to 1 do
      begin
        for iy := 0 to 1 do
        begin
          if ify + iy < Bmp.Height then
            sli := Bmp.ScanLine[ify + iy]
          else
            sli := Bmp.ScanLine[Bmp.Height - ify - iy];
          if ifx + ix < Bmp.Width then
          begin
            new_red := sli[(ifx + ix) * bpp];
            new_green := sli[(ifx + ix) * bpp + 1];
            new_blue := sli[(ifx + ix) * bpp + 2];
          end
          else
          begin
            new_red := sli[(Bmp.Width - ifx - ix) * bpp];
            new_green := sli[(Bmp.Width - ifx - ix) * bpp + 1];
            new_blue := sli[(Bmp.Width - ifx - ix) * bpp + 2];
          end;
          Weight := WeightX[ix] * WeightY[iy];
          total_red := total_red + new_red * Weight;
          total_green := total_green + new_green * Weight;
          total_blue := total_blue + new_blue * Weight;
        end;
      end;
      slo := Dst.ScanLine[ty];
      slo[tx * bpp] := Round(total_red);
      slo[tx * bpp + 1] := Round(total_green);
      slo[tx * bpp + 2] := Round(total_blue);
    end;
  end;
end;

class procedure TJvPaintFX.Wave(const Dst: TBitmap; Amount, Inference, Style: Integer);
var
  X, Y: Integer;
  Bitmap: TBitmap;
  P1, P2: PByteArray;
  B: Integer;
  Angle: Extended;
  wavex: Integer;
begin
  Bitmap := TBitmap.Create;
  Bitmap.Assign(Dst);
  wavex := Style;
  Angle := Pi / 2 / Amount;
  for Y := Bitmap.Height - 1 - (2 * Amount) downto Amount do
  begin
    P1 := Bitmap.ScanLine[Y];
    B := 0;
    for X := 0 to Bitmap.Width - 1 do
    begin
      P2 := Dst.ScanLine[Y + Amount + B];
      P2[X * bpp] := P1[X * bpp];
      P2[X * bpp + 1] := P1[X * bpp + 1];
      P2[X * bpp + 2] := P1[X * bpp + 2];
      case wavex of
        0:
          B := Amount * Variant(Sin(Angle * X));
        1:
          B := Amount * Variant(Sin(Angle * X) * Cos(Angle * X));
        2:
          B := Amount * Variant(Sin(Angle * X) * Sin(Inference * Angle * X));
      end;
    end;
  end;
  Bitmap.Free;
end;

class procedure TJvPaintFX.MakeSeamlessClip(var Dst: TBitmap; Seam: Integer);
var
  p0, P1, P2: PByteArray;
  H, W, I, J, sv, sh: Integer;
  f0, f1, f2: real;
begin
  H := Dst.Height;
  W := Dst.Width;
  sv := H div Seam;
  sh := W div Seam;
  P1 := Dst.ScanLine[0];
  P2 := Dst.ScanLine[H - 1];
  for I := 0 to W - 1 do
  begin
    P1[I * bpp] := P2[I * bpp];
    P1[I * bpp + 1] := P2[I * bpp + 1];
    P1[I * bpp + 2] := P2[I * bpp + 2];
  end;
  p0 := Dst.ScanLine[0];
  P2 := Dst.ScanLine[sv];
  for J := 1 to sv - 1 do
  begin
    P1 := Dst.ScanLine[J];
    for I := 0 to W - 1 do
    begin
      f0 := (P2[I * bpp] - p0[I * bpp]) / sv * J + p0[I * bpp];
      P1[I * bpp] := Round(f0);
      f1 := (P2[I * bpp + 1] - p0[I * bpp + 1]) / sv * J + p0[I * bpp + 1];
      P1[I * bpp + 1] := Round(f1);
      f2 := (P2[I * bpp + 2] - p0[I * bpp + 2]) / sv * J + p0[I * bpp + 2];
      P1[I * bpp + 2] := Round(f2);
    end;
  end;
  for J := 0 to H - 1 do
  begin
    P1 := Dst.ScanLine[J];
    P1[(W - 1) * bpp] := P1[0];
    P1[(W - 1) * bpp + 1] := P1[1];
    P1[(W - 1) * bpp + 2] := P1[2];
    for I := 1 to sh - 1 do
    begin
      f0 := (P1[(W - sh) * bpp] - P1[(W - 1) * bpp]) / sh * I + P1[(W - 1) * bpp];
      P1[(W - 1 - I) * bpp] := Round(f0);
      f1 := (P1[(W - sh) * bpp + 1] - P1[(W - 1) * bpp + 1]) / sh * I + P1[(W - 1) * bpp + 1];
      P1[(W - 1 - I) * bpp + 1] := Round(f1);
      f2 := (P1[(W - sh) * bpp + 2] - P1[(W - 1) * bpp + 2]) / sh * I + P1[(W - 1) * bpp + 2];
      P1[(W - 1 - I) * bpp + 2] := Round(f2);
    end;
  end;
end;

class procedure TJvPaintFX.SplitLight(const Dst: TBitmap; Amount: Integer);
var
  X, Y, I: Integer;
  P: PJvRGBArray;
  OPF: TPixelFormat;

  function Sinus(A: Integer): Integer;
  begin
    Result := Round(Sin(A / 255 * Pi / 2) * 255);
  end;

begin
  OPF := Dst.PixelFormat;
  Dst.PixelFormat := pf24bit;
  for I := 1 to Amount do
    for Y := 0 to Dst.Height - 1 do
    begin
      P := Dst.ScanLine[Y];
      for X := 0 to Dst.Width - 1 do
      begin
        P[X].rgbBlue  := Sinus(P[X].rgbBlue);
        P[X].rgbGreen := Sinus(P[X].rgbGreen);
        P[X].rgbRed   := Sinus(P[X].rgbRed);
      end;
    end;
  Dst.PixelFormat := OPF;
end;

class procedure TJvPaintFX.SqueezeHor(Src, Dst: TBitmap; Amount: Integer; Style: TLightBrush);
var
  DX, X, Y, C, CX: Integer;
  R: TRect;
  Bm: TBitmap;
  p0, P1: PByteArray;
begin
  if Amount > (Src.Width div 2) then
    Amount := Src.Width div 2;
  Bm := TBitmap.Create;
  Bm.PixelFormat := pf24bit;
  Bm.Height := 1;
  Bm.Width := Src.Width;
  CX := Src.Width div 2;
  p0 := Bm.ScanLine[0];
  for Y := 0 to Src.Height - 1 do
  begin
    P1 := Src.ScanLine[Y];
    for X := 0 to Src.Width - 1 do
    begin
      C := X * bpp;
      p0[C] := P1[C];
      p0[C + 1] := P1[C + 1];
      p0[C + 2] := P1[C + 2];
    end;
    case Style of
      mbHor:
        begin
          DX := Amount;
          R := Rect(DX, Y, Src.Width - DX, Y + 1);
        end;
      mbTop:
        begin
          DX := Round((Src.Height - 1 - Y) / Src.Height * Amount);
          R := Rect(DX, Y, Src.Width - DX, Y + 1);
        end;
      mbBottom:
        begin
          DX := Round(Y / Src.Height * Amount);
          R := Rect(DX, Y, Src.Width - DX, Y + 1);
        end;
      mbDiamond:
        begin
          DX := Round(Amount * Abs(Cos(Y / (Src.Height - 1) * Pi)));
          R := Rect(DX, Y, Src.Width - DX, Y + 1);
        end;
      mbWaste:
        begin
          DX := Round(Amount * Abs(Sin(Y / (Src.Height - 1) * Pi)));
          R := Rect(DX, Y, Src.Width - DX, Y + 1);
        end;
      mbRound:
        begin
          DX := Round(Amount * Abs(Sin(Y / (Src.Height - 1) * Pi)));
          R := Rect(CX - DX, Y, CX + DX, Y + 1);
        end;
      mbRound2:
        begin
          DX := Round(Amount * Abs(Sin(Y / (Src.Height - 1) * Pi * 2)));
          R := Rect(CX - DX, Y, CX + DX, Y + 1);
        end;
    end;
    Dst.Canvas.StretchDraw(R, Bm);
  end;
  Bm.Free;
end;

class procedure TJvPaintFX.Tile(Src, Dst: TBitmap; Amount: Integer);
var
  w2, h2, I, J: Integer;
  Bmp: TBitmap;
begin
  Dst.Assign(Src);
  if (Amount <= 0) or ((Src.Width div Amount) < 5) or ((Src.Height div Amount) < 5) then
    Exit;
  h2 := Src.Width div Amount;
  w2 := Src.Height div Amount;
  Bmp := TBitmap.Create;
  Bmp.Width := w2;
  Bmp.Height := h2;
  Bmp.PixelFormat := pf24bit;
  SmoothResize(Src, Bmp);
  for J := 0 to Amount - 1 do
    for I := 0 to Amount - 1 do
      Dst.Canvas.Draw(I * w2, J * h2, Bmp);
  Bmp.Free;
end;

// ---------------------------------------------------------------------------
// Interpolator
// ---------------------------------------------------------------------------
type
  // Contributor for a pixel
  TContributor = record
    Pixel: Integer; // Source pixel
    Weight: Single; // Pixel Weight
  end;

  TContributorList = array [0..0] of TContributor;
  PContributorList = ^TContributorList;

  // List of source pixels contributing to a destination pixel
  TCList = record
    N: Integer;
    P: PContributorList;
  end;

  TCListList = array [0..0] of TCList;
  PCListList = ^TCListList;

  TRGB = packed record
    R: Single;
    G: Single;
    B: Single;
  end;

  // Physical bitmap pixel
  TColorRGB = packed record
    R: Byte;
    G: Byte;
    B: Byte;
  end;
  PColorRGB = ^TColorRGB;

  // Physical bitmap ScanLine (row)
  TRGBList = packed array [0..0] of TColorRGB;
  PRGBList = ^TRGBList;

class procedure TJvPaintFX.Stretch(Src, Dst: TBitmap; Filter: TFilterProc;
  AWidth: Single);
var
  xscale, yscale: Single; // Zoom Scale factors
  I, J, k: Integer; // Loop variables
  Center: Single; // Filter calculation variables
  Width, fscale, Weight: Single; // Filter calculation variables
  Left, Right: Integer; // Filter calculation variables
  N: Integer; // Pixel number
  Work: TBitmap;
  Contrib: PCListList;
  RGB: TRGB;
  Color: TColorRGB;
  SourceLine, DestLine: PRGBList;
  SourcePixel, DestPixel: PColorRGB;
  Delta, DestDelta: Integer;
  SrcWidth, SrcHeight, DstWidth, DstHeight: Integer;

  function Color2RGB(Color: TColor): TColorRGB;
  begin
    Result.R := Color and $000000FF;
    Result.G := (Color and $0000FF00) shr 8;
    Result.B := (Color and $00FF0000) shr 16;
  end;

  function RGB2Color(Color: TColorRGB): TColor;
  begin
    Result := Color.R or (Color.G shl 8) or (Color.B shl 16);
  end;

begin
  DstWidth := Dst.Width;
  DstHeight := Dst.Height;
  SrcWidth := Src.Width;
  SrcHeight := Src.Height;
  if (SrcWidth < 1) or (SrcHeight < 1) then
    raise Exception.CreateRes(@RsESourceBitmapTooSmall);

  // Create intermediate image to hold horizontal zoom
  Work := TBitmap.Create;
  try
    Work.Height := SrcHeight;
    Work.Width := DstWidth;
    // xscale := DstWidth / SrcWidth;
    // yscale := DstHeight / SrcHeight;
    // Improvement suggested by David Ullrich:
    if (SrcWidth = 1) then
      xscale := DstWidth / SrcWidth
    else
      xscale := (DstWidth - 1) / (SrcWidth - 1);
    if (SrcHeight = 1) then
      yscale := DstHeight / SrcHeight
    else
      yscale := (DstHeight - 1) / (SrcHeight - 1);
    // This implementation only works on 24-bit images because it uses
    // TBitmap.ScanLine
    Src.PixelFormat := pf24bit;
    Dst.PixelFormat := Src.PixelFormat;
    Work.PixelFormat := Src.PixelFormat;

    // --------------------------------------------
    // Pre-calculate filter contributions for a row
    // -----------------------------------------------
    GetMem(Contrib, DstWidth * SizeOf(TCList));
    // Horizontal sub-sampling
    // Scales from bigger to smaller Width
    if (xscale < 1.0) then
    begin
      Width := AWidth / xscale;
      fscale := 1.0 / xscale;
      for I := 0 to DstWidth - 1 do
      begin
        Contrib^[I].N := 0;
        GetMem(Contrib^[I].P, Trunc(Width * 2.0 + 1) * SizeOf(TContributor));
        Center := I / xscale;
        // Original code:
        // Left := Ceil(Center - Width);
        // Right := Floor(Center + Width);
        Left := Floor(Center - Width);
        Right := Ceil(Center + Width);
        for J := Left to Right do
        begin
          Weight := Filter((Center - J) / fscale) / fscale;
          if (Weight = 0.0) then
            Continue;
          if (J < 0) then
            N := -J
          else
          if (J >= SrcWidth) then
            N := SrcWidth - J + SrcWidth - 1
          else
            N := J;
          k := Contrib^[I].N;
          Contrib^[I].N := Contrib^[I].N + 1;
          Contrib^[I].P^[k].Pixel := N;
          Contrib^[I].P^[k].Weight := Weight;
        end;
      end;
    end