unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Math;
type
TResampleFilter = function(Value: Single): Single;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
function Sinc(Value: Single): Single;
begin
if Value <> 0.0 then begin
Value := Value * Pi;
Result := Sin(Value) / Value;
end
else Result := 1.0;
end;
function Lanczos3Filter(Value: Single): Single;
begin
if Value < 0.0 then Value := -Value;
if Value < 3.0 then
Result := SinC(Value) * SinC(Value / 3.0)
else
Result := 0.0;
end;
function Limit(Min, Max, Val: Integer): Integer;
begin
if Val < Min then Exit(Min);
if Val > Max then Exit(Max);
Exit(Val);
end;
function Clip(Val: Extended): Byte;
begin
if Val > 255 then Exit(255);
if Val < 0 then Exit(0);
Result := Round(Val);
end;
function Resample(Bmp: TBitmap; AWidth, AHeight: Integer; Filter: TResampleFilter): TBitmap;
var x,y: Integer;
P: TColor;
PP: array[0..3] of Byte absolute P;
i,j: Integer;
ratioX,ratioY: Extended;
SumR, SumG, SumB: Extended;
xx,yy: Extended;
xxx,yyy: Integer;
xxxx,yyyy: Integer;
Tmp: Single;
RadX, RadY: Single;
begin
Result := TBitmap.Create;
Result.PixelFormat := pf32bit;
Result.SetSize(AWidth, AHeight);
ratioX := AWidth/ Bmp.Width;
ratioY := AHeight/ Bmp.Height;
for y:=0 to AHeight-1 do begin
for x:=0 to AWidth-1 do begin
xx := x / ratioX;
yy := y / ratioY;
xxx := Floor(xx);
yyy := Floor(yy);
SumR := 0;
SumG := 0;
SumB := 0;
for j:=-3 to 3 do
for i:=-3 to 3 do begin
RadX := xx - (xxx + i);
RadY := yy - (yyy + j);
Tmp := Filter(RadX) * Filter(RadY);
xxxx := Limit(0, Bmp.Width-1, xxx+i);
yyyy := Limit(0, Bmp.Height-1, yyy+j);
P := Bmp.Canvas.Pixels[xxxx, yyyy];
SumR := SumR + PP[0]*Tmp ;
SumG := SumG + PP[1]*Tmp ;
SumB := SumB + PP[2]*Tmp ;
end;
Result.Canvas.Pixels[x,y] := RGBToColor( Clip(SumR), Clip(SumG), Clip(SumB) );
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var InB, OutB: TBitmap;
begin
InB := TBitmap.Create;
InB.LoadFromFile('1.bmp'); //should be 32bpp
OutB := Resample(InB, 50, 50, @Lanczos3Filter);
OutB.SaveToFile('2.bmp');
OutB.Free;
InB.Free;
end;
end.