17 Sept 99 E-mail from Lazikas o Pontios:


...this is the code of resampling an image using interpolation. This code
was written a lot of years before Delphi came on and we had to create our
own structures for images :-). Lets say we have an image structure of :

type gifrec =  record
       Width, height : integer;  // dimension of image
       colors : byte;            // max number of gray levels of image.
       other_info ...            // any other info we need for image
     end;

Lets say now that we want to zoom the image with a factor of zoom ( zoom:
real). The new image has newwidth = width*zoom & newheight=
height*zoom dimension.  Of course, newwidth & newheight must be
integers. For each pixel we calculate its new color with following code :

for y:=0 to nheight-1   do
begin
  for x:=0 to nwidth-1 do
  begin
    xr:=x/zoom;
    yr:=y/zoom;
    If (round(xr)=xr) and (round(yr)=yr) then // get the exact value of pixel instead of                                                  // using interpolation !
    ncolor:=RC(round(x),round(y))  else       // use desire interpolation method
    ncolor:=Bilinear (xr,yr);                 // Use nearest or Bicubic, too !

    Put_Pixel (x,y,ncolor);                   // Write new pixel color into new image.
  end;
end;

The function RC(x,y) is similar to Delphi's  Pixels[x,y]. Of course, in Delphi we must use the Scanline
instead of Pixels :-)


Function Nearest (x,y:real):byte;
var j,k:integer;
begin
 j:=round(x+0.5);
 k:=round(y+0.5);
 Nearest:=RC (j,k);
end;

FUNCTION Bilinear (x,y:real) : byte;
var j,k:integer;
var a,b:real;
var dest:real;
var color:integer;
begin
  j:=round (x);
  k:=round (y);
  a:=x-j;
  b:=y-k;
  dest:=(1-a)*(1-b)*RC(j,k)+
a*(1-b)*RC(j+1,K)+
b*(1-A)*rc(J,K+1)+
a*b*RC(j+1,K+1);
  color:=round(dest);
  if color<0 then color:=abs(color);  // cannot have negative values !
  if (color>gifrec.colors) then color:=gifrec.colors;
  Bilinear:=color;
end;

FUNCTION Bicubic (x,y:real) : byte;
var j,k:integer;
var a,b:real;
var dest:real;
var t1,t2,t3,t4:real;
var color:integer;
begin
  j:=round (x);
  k:=round (y);
  a:=x-j;
  b:=y-k;
  t1:=-a*(1-a)*(1-a)*RC(j-1,k-1)+
         (1-2*a*a+a*a*a)*RC(j,k-1)+
       a*(1+a-a*a)*RC(j+1,k-1)-
       a*a*(1-a)*RC(j+2,k-1);
  t2:=-a*(1-a)*(1-a)*RC(j-1,k)+
         (1-2*a*a+a*a*a)*RC(j,k)+
       a*(1+a-a*a)*RC(j+1,k)-
       a*a*(1-a)*RC(j+2,k);
  t3:=-a*(1-a)*(1-a)*RC(j-1,k+1)+
         (1-2*a*a+a*a*a)*RC(j,k+1)+
       a*(1+a-a*a)*RC(j+1,k+1)-
       a*a*(1-a)*RC(j+2,k+1);
  t4:=-a*(1-a)*(1-a)*RC(j-1,k+2)+
         (1-2*a*a+a*a*a)*RC(j,k+2)+
       a*(1+a-a*a)*RC(j+1,k+2)-
       a*a*(1-a)*RC(j+2,k+2);

  dest:= -b*(1-b)*(1-b)*t1+
            (1-2*b*b+b*b*b)*t2+
          b*(1+b-b*b)*t3+
          b*b*(b-1)*t4;
  color:=round(dest);
  if color<0 then color:=abs(color);  // cannot have negative values !
  if (color>gifrec.colors) then color:=gifrec.colors; //
  Bicubic:=color;
end;


Hope this helps you to zoom an image using interpolation methods.

Lazikas o Pontios