// Zmiana wielkosci obrazka -
// Algorytm Biquadric Interpolation - algorytm podwojnej interpolacji kwadratowej
// www.algorytm.org
// Tomasz Lubinski (c) 2006

unit Bqi;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Math;

type
  PPixelRec = ^TPixelRec;
  TPixelRec = packed record
    B: Byte;
    G: Byte;
    R: Byte;
    Reserved: Byte;
  end;

  TForm1 = class(TForm)
    src: TImage;
    dst: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    function Biquadric_Inter(x, y: Double): TPixelRec;
    function Inter(f1, f2, f3, d: Double): Double;
    function InterNorm(f1, f2, f3, d: Double): Byte;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  org: Array [1..122] of Array [1..100] of TPixelRec;

implementation

{$R *.DFM}
function TForm1.Inter(f1, f2, f3, d: Double): Double;
begin
   Result := f2 + (f3 - f1)*d + (f1 - 2*f2 + f3)*d*d;
end;

function TForm1.InterNorm(f1, f2, f3, d: Double): Byte;
var
   Inter: Double;
begin
   Inter := f2 + (f3 - f1)*d + (f1 - 2*f2 + f3)*d*d;
   if (Inter > 255) then Result := 255
   else if (Inter < 0) then Result := 0
   else Result := Round(Inter);
end;

function TForm1.Biquadric_Inter(x, y: Double): TPixelRec;
var
  x0,y0,x0_1, y0_1,x0_2,y0_2 : Integer;
  dx,dy : Double;
begin
  x0_1 := Floor(x);
  y0_1 := Floor(y);

  dx := (x-x0_1)*0.5;
  dy := (y-y0_1)*0.5;
  if (x0_1 - 1 > 0) then
     x0 := x0_1 - 1
  else
     x0 := x0_1;
  if (y0_1 - 1 > 0) then
     y0 := y0_1 - 1
  else
     y0 := y0_1;
  if (x0_1 + 1 > src.Width) then
     x0_2 := x0_1
  else
     x0_2 := x0_1 + 1;
  if (y0_1 + 1 > src.Width) then
     y0_2 := y0_1
  else
     y0_2 := y0_1 + 1;

  Result.r := InterNorm(Inter(org[x0, y0].R, org[x0_1, y0].R, org[x0_2, y0].R, dx),
                        Inter(org[x0, y0_1].R, org[x0_1, y0_1].R, org[x0_2, y0_1].R, dx),
                        Inter(org[x0, y0_2].R, org[x0_1, y0_2].R, org[x0_2, y0_2].R, dx), dy);
  Result.g := InterNorm(Inter(org[x0, y0].G, org[x0_1, y0].G, org[x0_2, y0].G, dx),
                        Inter(org[x0, y0_1].G, org[x0_1, y0_1].G, org[x0_2, y0_1].G, dx),
                        Inter(org[x0, y0_2].G, org[x0_1, y0_2].G, org[x0_2, y0_2].G, dx), dy);
  Result.b := InterNorm(Inter(org[x0, y0].B, org[x0_1, y0].B, org[x0_2, y0].B, dx),
                        Inter(org[x0, y0_1].B, org[x0_1, y0_1].B, org[x0_2, y0_1].B, dx),
                        Inter(org[x0, y0_2].B, org[x0_1, y0_2].B, org[x0_2, y0_2].B, dx), dy);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   i,j: Integer;
   ratiox, ratioy : Double;
   pixel: PPixelRec;
begin
   //pobierz wartosci pliku wejsciowego
   src.Picture.Bitmap.PixelFormat := pf32Bit;
   for j:= 1 to src.Height do
   begin
      pixel := src.Picture.Bitmap.ScanLine[j-1];
      for i:=1 to src.Width do
         begin
            org[i][j] := pixel^;
            Inc(pixel);
         end;
   end;

   //pobierz nowy rozmiar
   dst.Width := StrToInt(Edit2.Text);
   dst.Height := StrToInt(Edit1.Text);
   dst.Picture.Bitmap := TBitmap.Create;
   dst.Picture.Bitmap.Width := dst.Width;
   dst.Picture.Bitmap.Height := dst.Height;
   ratiox := (src.Width-1)/(dst.Width-1);
   ratioy := (src.Height-1)/(dst.Height-1);

   //przygotuj obraz wynikowy
   dst.Canvas.Brush.Color := clWhite;
   dst.Canvas.Rectangle(0, 0, dst.Width, dst.Height);
   dst.Picture.Bitmap.PixelFormat := pf32Bit;

   for j:= 1 to dst.Height do
   begin
      pixel := dst.Picture.Bitmap.ScanLine[j-1];
      for i:=1 to dst.Width do
         begin
            pixel^ := Biquadric_Inter((i-1)*ratiox+1, (j-1)*ratioy+1);
            Inc(pixel);
         end;
   end;
end;

end.