Pomniejszanie obrazka -interpolacja

0

Chcę dodać w programie pomniejszanie obrazka i przeszukuję bezskutecznie internet w poszukiwaniu gotowego kodu.

Czy znasz jakiś adres opisu dobrego algorytmu, albo posiadasz kod zmniejszania bitmapy?
Oczywiście zmniejszanie musi być z wygładzaniem.

0

Proponuję gotowe komponenty:
http://sourceforge.net/projects/graphics32

Ponadto na forum temat był wielokrotnie omawiany.

0

Sprawdź to

unit BitmapResize;

interface

uses
  Windows, Classes, SysUtils, Graphics;

const PixelCountMax = 32768;

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [0..PixelCountMax - 1] of TRGBTriple;

procedure ResizeBicubic(Src: TBitmap; var Dest: TBitmap;
  DestWidth, DestHeight, SrcWidth, SrcHeight: integer);

procedure ResizeBilinear(Src: TBitmap; var Dest: TBitmap;
  DestWidth, DestHeight, SrcWidth, SrcHeight: integer);

procedure ResizeNearestNeighbor(Src: TBitmap; var Dest: TBitmap;
  DestWidth, DestHeight, SrcWidth, SrcHeight: integer);

implementation

function Sinc(x: double): double;
begin
  if abs(x) < 1 then
    Result := 1 - 2 * x * x + x * x * abs(x)
  else if (abs(x) >= 1) and (abs(x) < 2) then
    Result := 4 - 8 * abs(x) + 5 * x * x - x * x * abs(x)
  else Result := 0;
end;

procedure Bicubic(I1, I2, I3, I4: TRGBTriple; var New: TRGBTriple; u: double);
var
  t: integer;
begin
  t := trunc(I1.rgbtRed * Sinc(u + 1) + I2.rgbtRed
    * Sinc(u) + I3.rgbtRed * Sinc(u - 1) + I4.rgbtRed * Sinc(u - 2));
  if t > 255 then t := 255;
  if t < 0 then t := 0;
  New.rgbtRed := Byte(t);

  t := trunc(I1.rgbtGreen * Sinc(u + 1) + I2.rgbtGreen
    * Sinc(u) + I3.rgbtGreen * Sinc(u - 1) + I4.rgbtGreen * Sinc(u - 2));
  if t > 255 then t := 255;
  if t < 0 then t := 0;
  New.rgbtGreen := Byte(t);

  t := trunc(I1.rgbtBlue * Sinc(u + 1) + I2.rgbtBlue
    * Sinc(u) + I3.rgbtBlue * Sinc(u - 1) + I4.rgbtBlue * Sinc(u - 2));
  if t > 255 then t := 255;
  if t < 0 then t := 0;
  New.rgbtBlue := Byte(t);
end;

procedure ResizeBicubic(Src: TBitmap; var Dest: TBitmap;
  DestWidth, DestHeight, SrcWidth, SrcHeight: integer);
var
  hScale, wScale: double;
  f1, f2, f3, f4, fNew: TRGBTriple;
  temp1, temp2, temp3, temp4, tempDst: PRGBTripleArray;
  x, y, u, v: double;
  x1, x2, x3, x4, y1, y2, y3, y4, i, j, tempRGB: integer;
begin
  Dest := TBitmap.Create;
  Dest.PixelFormat := pf24Bit;
  Dest.Width := DestWidth;
  Dest.Height := DestHeight;

  Src.PixelFormat := pf24Bit;
  Src.Width := SrcWidth;
  Src.Height := SrcHeight;

  hScale := DestHeight / SrcHeight;
  wScale := DestWidth / SrcWidth;

  for i := 0 to DestHeight - 1 do
  begin
    x := i / hScale;
    x2 := trunc(x);
    x1 := x2 - 1;
    x3 := x2 + 1;
    x4 := x2 + 2;
    if x1 < 0 then x1 := 0;
    if x3 > SrcHeight - 1 then x3 := SrcHeight - 1;
    if x4 > SrcHeight - 1 then x4 := SrcHeight - 1;

    temp1 := Src.ScanLine[x1];
    temp2 := Src.ScanLine[x2];
    temp3 := Src.ScanLine[x3];
    temp4 := Src.ScanLine[x4];
    tempDst := Dest.ScanLine[i];

    v := x - x2;

    for j := 0 to DestWidth - 1 do
    begin
      y := j / wScale;
      y2 := trunc(y);
      y1 := y2 - 1;
      y3 := y2 + 1;
      y4 := y2 + 2;
      if y1 < 0 then y1 := 0;
      if y3 > SrcWidth - 1 then y3 := SrcWidth - 1;
      if y4 > SrcWidth - 1 then y4 := SrcWidth - 1;

      u := y - y2;

      Bicubic(temp1^[y1], temp1^[y2], temp1^[y3], temp1^[y4], f1, u);
      Bicubic(temp2^[y1], temp2^[y2], temp2^[y3], temp2^[y4], f2, u);
      Bicubic(temp3^[y1], temp3^[y2], temp3^[y3], temp3^[y4], f3, u);
      Bicubic(temp4^[y1], temp4^[y2], temp4^[y3], temp4^[y4], f4, u);
      Bicubic(f1, f2, f3, f4, fNew, v);

      tempDst^[j] := fNew;
    end;
  end;
end;

procedure ResizeBilinear(Src: TBitmap; var Dest: TBitmap;
  DestWidth, DestHeight, SrcWidth, SrcHeight: integer);
var
  hScale, wScale: double;
  f1, f2, f3, f4, f12, f34, fNew: TRGBTriple;
  temp1, temp2, tempDst: PRGBTripleArray;
  x, y: double;
  x1, x2, y1, y2, i, j: integer;
begin
  Dest := TBitmap.Create;
  Dest.PixelFormat := pf24Bit;
  Dest.Width := DestWidth;
  Dest.Height := DestHeight;

  Src.PixelFormat := pf24Bit;
  Src.Width := SrcWidth;
  Src.Height := SrcHeight;

  hScale := DestHeight / SrcHeight;
  wScale := DestWidth / SrcWidth;

  for i := 0 to DestHeight - 1 do
  begin
    x := i / hScale;
    x1 := trunc(x);
    x2 := x1 + 1;
    if x2 > SrcHeight - 1 then x2 := SrcHeight - 1;

    temp1 := Src.ScanLine[x1];
    temp2 := Src.ScanLine[x2];
    tempDst := Dest.ScanLine[i];

    for j := 0 to DestWidth - 1 do
    begin
      y := j / wScale;
      y1 := trunc(y);
      y2 := y1 + 1;
      if y2 > SrcWidth - 1 then y2 := SrcWidth - 1;

      f1 := temp1^[y1];
      f2 := temp1^[y2];
      f3 := temp2^[y1];
      f4 := temp2^[y2];

      f12.rgbtRed := trunc(f1.rgbtRed + (y - y1) * (f2.rgbtRed - f1.rgbtRed));
      f12.rgbtGreen := trunc(f1.rgbtGreen + (y - y1) * (f2.rgbtGreen - f1.rgbtGreen));
      f12.rgbtBlue := trunc(f1.rgbtBlue + (y - y1) * (f2.rgbtBlue - f1.rgbtBlue));

      f34.rgbtRed := trunc(f3.rgbtRed + (y - y1) * (f4.rgbtRed - f3.rgbtRed));
      f34.rgbtGreen := trunc(f3.rgbtGreen + (y - y1) * (f4.rgbtGreen - f3.rgbtGreen));
      f34.rgbtBlue := trunc(f3.rgbtBlue + (y - y1) * (f4.rgbtBlue - f3.rgbtBlue));

      fNew.rgbtRed := trunc(f12.rgbtRed + (x - x1) * (f34.rgbtRed - f12.rgbtRed));
      fNew.rgbtGreen := trunc(f12.rgbtGreen + (x - x1) * (f34.rgbtGreen - f12.rgbtGreen));
      fNew.rgbtBlue := trunc(f12.rgbtBlue + (x - x1) * (f34.rgbtBlue - f12.rgbtBlue));

      tempDst^[j] := fNew;
    end;
  end;
end;

procedure ResizeNearestNeighbor(Src: TBitmap; var Dest: TBitmap;
  DestWidth, DestHeight, SrcWidth, SrcHeight: integer);
var
  hScale, wScale: double;
  fNew: TRGBTriple;
  tempSrc, tempDst: PRGBTripleArray;
  x, y, i, j: integer;
begin
  Dest := TBitmap.Create;
  Dest.PixelFormat := pf24Bit;
  Dest.Width := DestWidth;
  Dest.Height := DestHeight;

  Src.PixelFormat := pf24Bit;
  Src.Width := SrcWidth;
  Src.Height := SrcHeight;

  hScale := DestHeight / SrcHeight;
  wScale := DestWidth / SrcWidth;

  for i := 0 to DestHeight - 1 do
  begin
    x := round(i / hScale);
    if x > SrcHeight - 1 then x := SrcHeight - 1;

    tempSrc := Src.ScanLine[x];
    tempDst := Dest.ScanLine[i];

    for j := 0 to DestWidth - 1 do
    begin
      y := round(j / wScale);
      if y > SrcWidth - 1 then y := SrcWidth - 1;

      fNew := tempSrc^[y];
      tempDst^[j] := fNew;
    end;
  end;
end;

1 użytkowników online, w tym zalogowanych: 0, gości: 1