Resample image

resample.pas

procedure Resample(const Data: PByteArray; const Width, Height: LongInt; out OutData: PByteArray; const OutWidth, OutHeight: LongInt);
var
  i, j : LongInt;
  f    : array [0..1] of LongWord;
  Row  : array [0..1] of PByteArray;
  Pix  : array [0..3] of PByteArray;
  p    : array [0..1] of PLongArray;
  Step : LongInt;
  Buf  : PByteArray;
begin
  Step := Width * $10000 div OutWidth;

  p[0] := GetMemory(OutWidth * 4);
  p[1] := GetMemory(OutWidth * 4);

  f[0] := Step shr 2;
  f[1] := Step shr 2 * 3;
  for i := 0 to OutWidth - 1 do
  begin
    p[0]^[i] := 4 * (f[0] shr 16);
    p[1]^[i] := 4 * (f[1] shr 16);
    Inc(f[0], Step);
    Inc(f[1], Step);
  end;

  OutData := GetMemory(OutWidth * OutHeight * 4);
  Buf := OutData;
  for i := 0 to OutHeight - 1 do
  begin
    Row[0] := @Data[4 * Width * Trunc((i + 0.25) * Height / OutHeight)];
    Row[1] := @Data[4 * Width * Trunc((i + 0.75) * Height / OutHeight)];
    for j := 0 to OutWidth - 1 do
    begin
      Pix[0] := @Row[0][p[0]^[j]];
      Pix[1] := @Row[0][p[1]^[j]];
      Pix[2] := @Row[1][p[0]^[j]];
      Pix[3] := @Row[1][p[1]^[j]];
      Buf^[j * 4 + 0] := (Pix[0]^[0] + Pix[1]^[0] + Pix[2]^[0] + Pix[3]^[0]) shr 2;
      Buf^[j * 4 + 1] := (Pix[0]^[1] + Pix[1]^[1] + Pix[2]^[1] + Pix[3]^[1]) shr 2;
      Buf^[j * 4 + 2] := (Pix[0]^[2] + Pix[1]^[2] + Pix[2]^[2] + Pix[3]^[2]) shr 2;
      Buf^[j * 4 + 3] := (Pix[0]^[3] + Pix[1]^[3] + Pix[2]^[3] + Pix[3]^[3]) shr 2;
    end;
    Buf := @Buf^[OutWidth * 4];
  end;

  FreeMemory(p[0]);
  FreeMemory(p[1]);
end;