⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvqpaintfx.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  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: PJvRGBArray;
begin
  xmid := Bmp.Width / 2;
  ymid := Bmp.Height / 2;
  rmax := Dst.Width * Amount;

  for ty := 0 to Dst.Height - 1 do
  begin
    for tx := 0 to Dst.Width - 1 do
    begin
      DX := tx - xmid;
      DY := ty - ymid;
      r1 := Sqrt(DX * DX + DY * DY);
      if r1 = 0 then
      begin
        fx := xmid;
        fy := ymid;
      end
      else
      begin
        r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1);
        fx := DX * r2 / r1 + xmid;
        fy := DY * r2 / r1 + ymid;
      end;
      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].rgbRed;
            new_green := sli[ifx + ix].rgbGreen;
            new_blue  := sli[ifx + ix].rgbBlue;
          end
          else
          begin
            new_red   := sli[Bmp.Width - ifx - ix].rgbRed;
            new_green := sli[Bmp.Width - ifx - ix].rgbGreen;
            new_blue  := sli[Bmp.Width - ifx - ix].rgbBlue;
          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].rgbRed   := Round(total_red);
      slo[tx].rgbGreen := Round(total_green);
      slo[tx].rgbBlue  := Round(total_blue);
    end;
  end;
end;

class procedure TJvPaintFX.GaussianBlur(const Dst: TBitmap; Amount: Integer);
var
  I: Integer;
  OPF: TPixelFormat;
begin
  OPF := Dst.PixelFormat;
  Dst.PixelFormat := pf24bit;
  for I := Amount downto 0 do
    SplitBlur(Dst, 3);
  Dst.PixelFormat := OPF;
end;

class procedure TJvPaintFX.GrayScale(const Dst: TBitmap);
var
  Line: PJvRGBArray;
  Gray, X, Y: Integer;
  OPF: TPixelFormat;
begin
  OPF := Dst.PixelFormat;
  Dst.PixelFormat := pf24bit;
  for Y := 0 to Dst.Height - 1 do
  begin
    Line := Dst.ScanLine[Y];
    for X := 0 to Dst.Width - 1 do
    begin
      Gray := Round(Line[X].rgbRed * 0.3 + Line[X].rgbGreen * 0.59 + Line[X].rgbBlue * 0.11);
      Line[X].rgbRed   := Gray;
      Line[X].rgbGreen := Gray;
      Line[X].rgbBlue  := Gray;
    end;
  end;
  Dst.PixelFormat := OPF;
end;

class procedure TJvPaintFX.Lightness(const Dst: TBitmap; Amount: Integer);
var
  Line: PJvRGBArray;
  R, G, B, X, Y: Integer;
  OPF: TPixelFormat;
begin
  OPF := Dst.PixelFormat;
  Dst.PixelFormat := pf24bit;
  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;
      Line[X].rgbRed   := IntToByte(R + ((255 - R) * Amount) div 255);
      Line[X].rgbGreen := IntToByte(G + ((255 - G) * Amount) div 255);
      Line[X].rgbBlue  := IntToByte(B + ((255 - B) * Amount) div 255);
    end;
  end;
  Dst.PixelFormat := OPF;
end;

class procedure TJvPaintFX.Darkness(const Dst: TBitmap; Amount: Integer);
var
  Line: PJvRGBArray;
  R, G, B, X, Y: Integer;
  OPF: TPixelFormat;
begin
  OPF := Dst.PixelFormat;
  Dst.PixelFormat := pf24bit;
  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;
      Line[X].rgbRed   := IntToByte(R - (R * Amount) div 255);
      Line[X].rgbGreen := IntToByte(G - (G * Amount) div 255);
      Line[X].rgbBlue  := IntToByte(B - (B * Amount) div 255);
    end;
  end;
  Dst.PixelFormat := OPF;
end;

class procedure TJvPaintFX.Marble(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;
  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
    YY := Scale * Cos((Y mod Turbulence) / Scale);
    Line1 := Source.ScanLine[Y];
    for X := 0 to W - 1 do
    begin
      XX := -Scale * Sin((X mod Turbulence) / 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.Marble2(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;
  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
    YY := Scale * Cos((Y mod Turbulence) / Scale);
    Line1 := Source.ScanLine[Y];
    for X := 0 to W - 1 do
    begin
      XX := -Scale * Sin((X mod Turbulence) / 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.Marble3(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;
  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
    YY := Scale * Cos((Y mod Turbulence) / Scale);
    Line1 := Source.ScanLine[Y];
    for X := 0 to W - 1 do
    begin
      XX := -Scale * Sin((X mod Turbulence) / 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.Marble4(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;
  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
    YY := Scale * Sin((Y mod Turbulence) / Scale);
    Line1 := Source.ScanLine[Y];
    for X := 0 to W - 1 do
    begin
      XX := -Scale * Cos((X mod Turbulence) / 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.Marble5(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;
  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 := H - 1 downto 0 do
  begin
    YY := Scale * Cos((Y mod Turbulence) / Scale);
    Line1 := Source.ScanLine[Y];
    for X := W - 1 downto 0 do
    begin
      XX := -Scale * Sin((X mod Turbulence) / 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.Marble6(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;
  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
    YY := Scale * Cos((Y mod Turbulence) / Scale);
    Line1 := Source.ScanLine[Y];
    for X := 0 to W - 1 do
    begin
      XX := -tan((X mod Turbulence) / 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.Marble7(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;
  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;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -