採用內差法與平滑化兩種演算法

procedure TForm1.BitBtn2Click(Sender: TObject);
var x1,y1,x2,y2,x0,y0,dx,dy,x,y:integer;
begin
   x1:=image1.width;
   y1:=image1.height;
   x2:=image2.width;
   y2:=image2.height;
   dx:=0;
   x0:=0;
   for x:=0 to image2.width-1 do
   begin
     dy:=0;
     y0:=0;
     dx:=dx+x1;
     while dx>=x2 do
     begin
        inc(x0);
        dx:=dx-x2;
     end;
     for y:=0 to image2.height-1 do
     begin
        dy:=dy+y1;
        while dy>=y2 do
        begin
           inc(y0);
           dy:=dy-y2;
        end;
       image2.Canvas.Pixels[x,y]:=image1.Canvas.Pixels[x0,y0];
     end;
   end;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var x1,y1,x2,y2,x0,y0:integer;
  x,y,dx,dy,nx,ny,i,j:integer;
  r,g,b,tot,c:integer;
begin
   x1:=image1.width;
   y1:=image1.height;
   x2:=image3.width;
   y2:=image3.height;
   dx:=0;
   x0:=0;
   for x:=0 to image3.width-1 do
   begin
     dy:=0;
     y0:=0;
     dx:=dx+x1;
     nx:=0;
     while dx>=x2 do
     begin
        inc(x0);
        inc(nx);
        dx:=dx-x2;
     end;
     for y:=0 to image3.height-1 do
     begin
        dy:=dy+y1;
        ny:=0;
        while dy>=y2 do
        begin
           inc(y0);
           inc(ny);
           dy:=dy-y2;
        end;
        r:=0; g:=0; b:=0;
        tot:=0;
        for i:=0 to nx do
        for j:=0 to ny do
        begin
           c:=image1.Canvas.Pixels[x0-i,y0-j];
           r:=r+(c shr 16);
           g:=g+((c shr 8) and 255);
           b:=b+(c and 255);
           inc(tot);
        end;

        r:=r div tot;
        g:=g div tot;
        b:=b div tot;
        c:=(r shl 16)+(g shl 8)+b;
       image3.Canvas.Pixels[x,y]:=c;
     end;
   end;
end;

台南小新 發表在 痞客邦 PIXNET 留言(0) 人氣()