jvqpaintfx.pas

East make Tray Icon in delphi

    else
      // Horizontal super-sampling
      // Scales from smaller to bigger Width
    begin
      for I := 0 to DstWidth - 1 do
      begin
        Contrib^[I].N := 0;
        GetMem(Contrib^[I].P, Trunc(AWidth * 2.0 + 1) * SizeOf(TContributor));
        Center := I / xscale;
        // Original code:
        // Left := Ceil(Center - AWidth);
        // Right := Floor(Center + AWidth);
        Left := Floor(Center - AWidth);
        Right := Ceil(Center + AWidth);
        for J := Left to Right do
        begin
          Weight := Filter(Center - J);
          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;

    // ----------------------------------------------------
    // Apply filter to sample horizontally from Src to Work
    // ----------------------------------------------------
    for k := 0 to SrcHeight - 1 do
    begin
      SourceLine := Src.ScanLine[k];
      DestPixel := Work.ScanLine[k];
      for I := 0 to DstWidth - 1 do
      begin
        RGB.R := 0.0;
        RGB.G := 0.0;
        RGB.B := 0.0;
        for J := 0 to Contrib^[I].N - 1 do
        begin
          Color := SourceLine^[Contrib^[I].P^[J].Pixel];
          Weight := Contrib^[I].P^[J].Weight;
          if (Weight = 0.0) then
            Continue;
          RGB.R := RGB.R + Color.R * Weight;
          RGB.G := RGB.G + Color.G * Weight;
          RGB.B := RGB.B + Color.B * Weight;
        end;
        if RGB.R > 255.0 then
          Color.R := 255
        else
        if RGB.R < 0.0 then
          Color.R := 0
        else
          Color.R := Round(RGB.R);
        if RGB.G > 255.0 then
          Color.G := 255
        else
        if RGB.G < 0.0 then
          Color.G := 0
        else
          Color.G := Round(RGB.G);
        if RGB.B > 255.0 then
          Color.B := 255
        else
        if RGB.B < 0.0 then
          Color.B := 0
        else
          Color.B := Round(RGB.B);
        // Set new Pixel value
        DestPixel^ := Color;
        // Move on to next column
        Inc(DestPixel);
      end;
    end;

    // Free the memory allocated for horizontal filter weights
    for I := 0 to DstWidth - 1 do
      FreeMem(Contrib^[I].P);

    FreeMem(Contrib);

    // -----------------------------------------------
    // Pre-calculate filter contributions for a column
    // -----------------------------------------------
    GetMem(Contrib, DstHeight * SizeOf(TCList));
    // Vertical sub-sampling
    // Scales from bigger to smaller Height
    if (yscale < 1.0) then
    begin
      Width := AWidth / yscale;
      fscale := 1.0 / yscale;
      for I := 0 to DstHeight - 1 do
      begin
        Contrib^[I].N := 0;
        GetMem(Contrib^[I].P, Trunc(Width * 2.0 + 1) * SizeOf(TContributor));
        Center := I / yscale;
        // 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 >= SrcHeight then
            N := SrcHeight - J + SrcHeight - 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
    else
      // Vertical super-sampling
      // Scales from smaller to bigger Height
    begin
      for I := 0 to DstHeight - 1 do
      begin
        Contrib^[I].N := 0;
        GetMem(Contrib^[I].P, Trunc(AWidth * 2.0 + 1) * SizeOf(TContributor));
        Center := I / yscale;
        // Original code:
        // Left := Ceil(Center - AWidth);
        // Right := Floor(Center + AWidth);
        Left := Floor(Center - AWidth);
        Right := Ceil(Center + AWidth);
        for J := Left to Right do
        begin
          Weight := Filter(Center - J);
          if Weight = 0.0 then
            Continue;
          if J < 0 then
            N := -J
          else
          if J >= SrcHeight then
            N := SrcHeight - J + SrcHeight - 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;

    // --------------------------------------------------
    // Apply filter to sample vertically from Work to Dst
    // --------------------------------------------------
    SourceLine := Work.ScanLine[0];
    Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine);
    DestLine := Dst.ScanLine[0];
    DestDelta := Integer(Dst.ScanLine[1]) - Integer(DestLine);
    for k := 0 to DstWidth - 1 do
    begin
      DestPixel := pointer(DestLine);
      for I := 0 to DstHeight - 1 do
      begin
        RGB.R := 0;
        RGB.G := 0;
        RGB.B := 0;
        // Weight := 0.0;
        for J := 0 to Contrib^[I].N - 1 do
        begin
          Color := PColorRGB(Integer(SourceLine) + Contrib^[I].P^[J].Pixel * Delta)^;
          Weight := Contrib^[I].P^[J].Weight;
          if (Weight = 0.0) then
            Continue;
          RGB.R := RGB.R + Color.R * Weight;
          RGB.G := RGB.G + Color.G * Weight;
          RGB.B := RGB.B + Color.B * Weight;
        end;
        if RGB.R > 255.0 then
          Color.R := 255
        else
        if RGB.R < 0.0 then
          Color.R := 0
        else
          Color.R := Round(RGB.R);
        if RGB.G > 255.0 then
          Color.G := 255
        else
        if RGB.G < 0.0 then
          Color.G := 0
        else
          Color.G := Round(RGB.G);
        if RGB.B > 255.0 then
          Color.B := 255
        else
        if RGB.B < 0.0 then
          Color.B := 0
        else
          Color.B := Round(RGB.B);
        DestPixel^ := Color;
        Inc(Integer(DestPixel), DestDelta);
      end;
      Inc(SourceLine, 1);
      Inc(DestLine, 1);
    end;

    // Free the memory allocated for vertical filter weights
    for I := 0 to DstHeight - 1 do
      FreeMem(Contrib^[I].P);

    FreeMem(Contrib);
  finally
    Work.Free;
  end;
end;

class procedure TJvPaintFX.Grow(Src1, Src2, Dst: TBitmap; Amount: Single; X, Y: Integer);
var
  Bmp: TBitmap;
begin
  Dst.Assign(Src1);
  Bmp := TBitmap.Create;
  Bmp.Width := Round(Amount * Src1.Width);
  Bmp.Height := Round(Amount * Src1.Height);
  Stretch(Src2, Bmp, ResampleFilters[4].Filter, ResampleFilters[4].Width);
  Dst.Canvas.Draw(X, Y, Bmp);
  Bmp.Free;
end;

class procedure TJvPaintFX.SpotLight(const Dst: TBitmap; Amount: Integer; Spot: TRect);
var
  Bmp: TBitmap;
begin
  Darkness(Dst, Amount);
  Bmp := TBitmap.Create;
  Bmp.Width := Dst.Width;
  Bmp.Height := Dst.Height;
  Bmp.Canvas.Brush.Color := clBlack;
  Bmp.Canvas.FillRect(Rect(0, 0, Dst.Width, Dst.Height));
  Bmp.Canvas.Brush.Color := clWhite;
  Bmp.Canvas.Ellipse(Spot.Left, Spot.Top, Spot.Right, Spot.Bottom);
  Bmp.Transparent := True;
  Bmp.TransparentColor := clWhite;
  Dst.Canvas.Draw(0, 0, Bmp);
  Bmp.Free;
end;

class procedure TJvPaintFX.FlipDown(const Dst: TBitmap);
var
  Bmp: TBitmap;
  W, H, X, Y: Integer;
  PD, PS: PByteArray;
begin
  W := Dst.Width;
  H := Dst.Height;
  Bmp := TBitmap.Create;
  Bmp.Width := W;
  Bmp.Height := H;
  Bmp.PixelFormat := pf24bit;
  Dst.PixelFormat := pf24bit;
  for Y := 0 to H - 1 do
  begin
    PD := Bmp.ScanLine[Y];
    PS := Dst.ScanLine[H - 1 - Y];
    for X := 0 to W - 1 do
    begin
      PD[X * bpp] := PS[X * bpp];
      PD[X * bpp + 1] := PS[X * bpp + 1];
      PD[X * bpp + 2] := PS[X * bpp + 2];
    end;
  end;
  Dst.Assign(Bmp);
  Bmp.Free;
end;

class procedure TJvPaintFX.FlipRight(const Dst: TBitmap);
var
  dest: TBitmap;
  W, H, X, Y: Integer;
  PD, PS: PByteArray;
begin
  W := Dst.Width;
  H := Dst.Height;
  dest := TBitmap.Create;
  dest.Width := W;
  dest.Height := H;
  dest.PixelFormat := pf24bit;
  Dst.PixelFormat := pf24bit;
  for Y := 0 to H - 1 do
  begin
    PD := dest.ScanLine[Y];
    PS := Dst.ScanLine[Y];
    for X := 0 to W - 1 do
    begin
      PD[X * bpp] := PS[(W - 1 - X) * bpp];
      PD[X * bpp + 1] := PS[(W - 1 - X) * bpp + 1];
      PD[X * bpp + 2] := PS[(W - 1 - X) * bpp + 2];
    end;
  end;
  Dst.Assign(dest);
  dest.Free;
end;

class procedure TJvPaintFX.Trace(const Dst: TBitmap; Intensity: Integer);
var
  X, Y, I: Integer;
  P1, P2, P3, P4: PByteArray;
  tb, TraceB: Byte;
  hasb: Boolean;
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  Bitmap.Width := Dst.Width;
  Bitmap.Height := Dst.Height;
  Bitmap.Canvas.Draw(0, 0, Dst);
  Bitmap.PixelFormat := pf8bit;
  Dst.PixelFormat := pf24bit;
  hasb := False;
  TraceB := $00;
  tb := 0;
  for I := 1 to Intensity do
  begin
    for Y := 0 to Bitmap.Height - 2 do
    begin
      P1 := Bitmap.ScanLine[Y];
      P2 := Bitmap.ScanLine[Y + 1];
      P3 := Dst.ScanLine[Y];
      P4 := Dst.ScanLine[Y + 1];
      X := 0;
      repeat
        if P1[X] <> P1[X + 1] then
        begin
          if not hasb then
          begin
            tb := P1[X + 1];
            hasb := True;
            P3[X * bpp] := TraceB;
            P3[X * bpp + 1] := TraceB;
            P3[X * bpp + 2] := TraceB;
          end
          else
          begin
            if P1[X] <> tb then
            begin
              P3[X * bpp] := TraceB;
              P3[X * bpp + 1] := TraceB;
              P3[X * bpp + 2] := TraceB;
            end
            else
            begin
              P3[(X + 1) * bpp] := TraceB;
              P3[(X + 1) * bpp + 1] := TraceB;
              P3[(X + 1) * bpp + 1] := TraceB;
            end;
          end;
        end;
        if P1[X] <> P2[X] then
        begin
          if not hasb then
          begin
            tb := P2[X];
            hasb := True;
            P3[X * bpp] := TraceB;
            P3[X * bpp + 1] := TraceB;
            P3[X * bpp + 2] := TraceB;
          end
          else
          begin
            if P1[X] <> tb then
            begin
              P3[X * bpp] := TraceB;
              P3[X * bpp + 1] := TraceB;
              P3[X * bpp + 2] := TraceB;
            end
            else
            begin
              P4[X * bpp] := TraceB;
              P4[X * bpp + 1] := TraceB;
              P4[X * bpp + 2] := TraceB;
            end;
          end;
        end;
        Inc(X);
      until X >= (Bitmap.Width - 2);
    end;
    // do the same in the opposite direction
    // only when Intensity > 1
    if I > 1 then
      for Y := Bitmap.Height - 1 downto 1 do
      begin
        P1 := Bitmap.ScanLine[Y];
        P2 := Bitmap.ScanLine[Y - 1];
        P3 := Dst.ScanLine[Y];
        P4 := Dst.ScanLine[Y - 1];
        X := Bitmap.Width - 1;
        repeat
          if P1[X] <> P1[X - 1] then
          begin
            if not hasb then
            begin
              tb := P1[X - 1];
              hasb := True;
              P3[X * bpp] := TraceB;
              P3[X * bpp + 1] := TraceB;
              P3[X * bpp + 2] := TraceB;
            end
            else
            begin
              if P1[X] <> tb then
              begin
                P3[X * bpp] := TraceB;
                P3[X * bpp + 1] := TraceB;
                P3[X * bpp + 2] := TraceB;
              end
              else
              begin
                P3[(X - 1) * bpp] := TraceB;
                P3[(X - 1) * bpp + 1] := TraceB;
                P3[(X - 1) * bpp + 2] := TraceB;
              end;
            end;
          end;
          if P1[X] <> P2[X] then
          begin
            if not hasb then
            begin
              tb := P2[X];
              hasb := True;
              P3[X * bpp] := Tr