### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### 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.

Straight assignment doesn't seem to work.

#### circular

• Hero Member
• Posts: 3508
##### 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