Recent

Author Topic: Resampling with Lanczos filter?  (Read 3808 times)

stab

  • Full Member
  • ***
  • Posts: 187
Resampling with Lanczos filter?
« on: October 15, 2013, 07:28:10 am »
Hi Circular,

Moved this topic from Graphics general as it is about BGRABitmap.

Have used your versatile BGRABitmap in quite a few applications( including android-app) and followed your advice and subclassed TWideKernelFilter as TLanczosKernel like:
Code: [Select]
  { TLanczosKernel }

  TLanczosKernel = class(TWideKernelFilter)
  private
    FNumberOfLobes: integer;
    procedure SetNumberOfLobes(AValue: integer);

  protected
  public
    function Interpolation(t: single): single; override;
    function ShouldCheckRange: boolean; override;
    function KernelWidth: single; override;

    property NumberOfLobes : integer read FNumberOfLobes write SetNumberOfLobes;
  end;

implementation

{ TLanczosKernel }

procedure TLanczosKernel.SetNumberOfLobes(AValue: integer);
begin
  if FNumberOfLobes=AValue then Exit;
  FNumberOfLobes:=AValue;
end;

function TLanczosKernel.Interpolation(t: single): single;
begin
  if t = 0 then
    Result := 1
  else if abs(t) < FNumberOfLobes then
    Result := FNumberOfLobes * sin(pi * t) * sin(pi * t / FNumberOfLobes) /
      (pi * pi * t * t)
  else
    Result := 0;
end;

function TLanczosKernel.ShouldCheckRange: boolean;
begin
  Result := True;
end;

function TLanczosKernel.KernelWidth: single;
begin
  Result := 3;
end;

and then used it in code like this:

Code: [Select]
procedure TfrmResampling.btnResampleClick(Sender: TObject);
begin
  case cbxFilters.ItemIndex of
    0: FBGRABitmap.ResampleFilter := rfLinear;
    1: FBGRABitmap.ResampleFilter := rfHalfCosine;
    2: FBGRABitmap.ResampleFilter := rfCosine;
    3: FBGRABitmap.ResampleFilter := rfBicubic;
    4: FBGRABitmap.ResampleFilter := rfMitchell;
    5: FBGRABitmap.ResampleFilter := rfSpline;
    6: FBGRABitmap.ResampleFilter := rfBestQuality;
    7:
    begin
      FResampledBitmap :=
        TBGRABitmap(WideKernelResample(FBGRABitmap,
        Image1.Width div 2, Image1.Height div 2,
        FLanczosKernel, FLanczosKernel));

      PaintBox1.Repaint;
      Exit;
    end;
  end;
  FResampledBitmap := FBGRABitmap.Resample(Image1.Width div 2, Image1.Height div 2) as TBGRABitmap;

  PaintBox1.Repaint;
end;

procedure TfrmResampling.PaintBox1Paint(Sender: TObject);
begin
  if FResampledBitmap = nil then Exit;

  FResampledBitmap.Draw(PaintBox1.Canvas, 0, 0);
  FreeAndNil(FResampledBitmap);
end;

I guess I'm using your code in BGRAResample wrong as the result is always like in attached png-file. To the left is an Image which is loaded into FBGRABitmap in Form.Create.
Both FBGRABitmap  and FResampledBitmap are of type TBGRABitmap.

What am I actually doing wrong?

/stab %)

stab

  • Full Member
  • ***
  • Posts: 187
Re: Resampling with Lanczos filter?
« Reply #1 on: October 21, 2013, 04:18:02 pm »
Found finally out what I'd done wrong.

In FormCreate my code was like:

Code: [Select]
procedure TfrmResampling.FormCreate(Sender: TObject);
begin
  FBGRABitmap := TBGRABitmap.Create(Image1.Width, Image1.Height);
  FBGRABitmap.Bitmap.Assign(Image1.Picture.Bitmap);
end;

It turned out that assigning an Image.Picture.Bitmap to BGRABitmap as above results
in an corrupted image in BGRABitmap .

Changed my code to:

Code: [Select]
procedure TfrmResampling.FormCreate(Sender: TObject);
var
  rect : TRect;
begin
  rect.Left := 0; rect.Top := 0;
  rect.Right := Image1.Width; rect.Bottom := Image1.Height;
  FBGRABitmap := TBGRABitmap.Create(Image1.Width, Image1.Height);
  FBGRABitmap.Canvas.CopyRect(rect, Image1.Picture.Bitmap.Canvas, rect);
end;

and now it works. :D

Straight assignment doesn't seem to work.



circular

  • Hero Member
  • *****
  • Posts: 3508
    • Personal webpage
Re: Resampling with Lanczos filter?
« Reply #2 on: April 24, 2014, 02:55:17 pm »
Hi,

I have added Lanczos filter in BGRABitmap on SVN. I fixed some things so here is the code after those modifications:
- the number of lobes is a parameter in the constructor (>= 1)
- the kernel width is equal to the number of lobes
- the factor is set to 1.5 when there is one lobe so that the sum of pixels is not under 1
Code: [Select]
type
  { TLanczosKernel }

  TLanczosKernel = class(TWideKernelFilter)
  private
    FNumberOfLobes: integer;
    FFactor: ValReal;
    procedure SetNumberOfLobes(AValue: integer);
  public
    constructor Create(ANumberOfLobes: integer);
    function Interpolation(t: single): single; override;
    function ShouldCheckRange: boolean; override;
    function KernelWidth: single; override;

    property NumberOfLobes : integer read FNumberOfLobes write SetNumberOfLobes;
  end;

{ TLanczosKernel }
procedure TLanczosKernel.SetNumberOfLobes(AValue: integer);
begin
  if AValue < 1 then AValue := 1;
  if FNumberOfLobes=AValue then Exit;
  FNumberOfLobes:=AValue;
  if AValue = 1 then FFactor := 1.5 else FFactor := AValue;
end;

constructor TLanczosKernel.Create(ANumberOfLobes: integer);
begin
  NumberOfLobes:= ANumberOfLobes;
end;

function TLanczosKernel.Interpolation(t: single): single;
var Pi_t: ValReal;
begin
  if t = 0 then
    Result := 1
  else if t < FNumberOfLobes then
  begin
    Pi_t := pi * t;
    Result := FFactor * sin(Pi_t) * sin(Pi_t / FNumberOfLobes) /
      (Pi_t * Pi_t)
  end
  else
    Result := 0;
end;

function TLanczosKernel.ShouldCheckRange: boolean;
begin
  Result := True;
end;

function TLanczosKernel.KernelWidth: single;
begin
  Result := FNumberOfLobes;
end;
Conscience is the debugger of the mind

 

TinyPortal © 2005-2018