* * *

Author Topic: Trying to Scale TBITMAP smoothly  (Read 821 times)

josh

  • Sr. Member
  • ****
  • Posts: 379
Trying to Scale TBITMAP smoothly
« on: February 09, 2017, 03:35:12 am »
I am trying to scale an image from an timagelist, the new image will only be  a maximum of 30% bigger than original so should render ok on the screen.

I have tried using Canvas.StretchDraw; but this pixilates the image too much.

So I thought I would try the routines in BGRABITMAP, but for some reason I do not get any images; it's obviously is me.

Hoping someone can have a look and show where I have gone wrong.


code snippet
Code: [Select]
var
  DestinationRect: TRect;
  bmp:      TBitmap;
  bmpBGRA: TBGRACustomBitmap;
begin
  if ((FCurValue>=0) and (FCurValue<images.Count)) then FImages.GetBitmap(FCurValue,FForeImage)
  else if FCurValue<0 then FImages.GetBitmap(0,FForeImage)
       else FImages.GetBitmap(Fimages.Count-1,FForeImage);
  DestinationRect     := Rect(0,0, self.width, self.Height);
  canvas.CopyMode    := cmSrcCopy;

 //   canvas.CopyRect(DestinationRect, FForeImage.Canvas, DestinationRect); //this works here but no scaling

  bmpBGRA:=TBGRABitmap.create(FForeImage);
  bmpBGRA.Canvas.Draw(0,0,FForeImage);
  bmpBGRA.ResampleFilter:=rfBestQuality;
  bmpBGRA.Resample(self.Width, self.Height, rmFineResample);
  with FForeImage do
  begin
    Clear;
    SetSize(self.Width,self.Height);
    Canvas.Draw(0,0,bmpBGRA.Bitmap);
  end;

  canvas.CopyRect(DestinationRect, FForeImage.Canvas, DestinationRect); 

Thanks

Josh
« Last Edit: May 01, 2017, 11:25:05 pm by josh »
Development Installation Lazarus 1.3, FPC 2.7.1,Windows 7/8 32/64, OSX, *nix

Test Environment Lazarus & FPC Trunk on Windows and OSX (Cocoa Mainly on OSX). Testing also Crosscompile windows to OSX.. 
Any posts made from 2015 will be based on Lazarus Trunk.

jacmoe

  • Sr. Member
  • ****
  • Posts: 255
    • Jacmoe's Cyber SoapBox
Re: Trying to Scale TBITMAP smoothly
« Reply #1 on: February 09, 2017, 03:57:30 am »
I haven't tried it myself yet, but I think that perhaps ImageMagick / MagickWand can be of use here, so that the image will be scaled without pixelation -> http://wiki.freepascal.org/PascalMagick#Procedures_to_load_images_to_a_Lazarus_TBitmap_with_ImageMagick

What I mean is: why not take advantage of the fact that other people have written clever algorithms for lossless manipulation of images?

Edit:
Looking at BGRABitmap repository, I realize that the library properly does most, if not all, of the things that ImageMagick does..
« Last Edit: February 09, 2017, 04:08:50 am by jacmoe »
more signal - less noise

Handoko

  • Hero Member
  • *****
  • Posts: 1404
  • My goal: build my own game engine using Lazarus
Re: Trying to Scale TBITMAP smoothly
« Reply #2 on: February 09, 2017, 04:04:11 am »
I don't use BGRABitmap, but I know there is a good tutorial about rotation:
See: Drawing with a 2D canvas with affine transformations (No. 14)

http://wiki.lazarus.freepascal.org/BGRABitmap_tutorial

--- edited:
Sorry my mistake. You should see the tutorial no. 11: Using scanners to combine transformations (No. 11)
« Last Edit: February 09, 2017, 04:17:32 am by Handoko »

josh

  • Sr. Member
  • ****
  • Posts: 379
Re: Trying to Scale TBITMAP smoothly
« Reply #3 on: February 09, 2017, 04:52:25 am »
Hi Guys,

Thanks for your replies, much appreciated.  I am trying to keep with BGRABITMAP as using this for other stuff, the ImageMagick does look interesting; I will have a look at that later.

Its nearly 4:00am and after a strong coffee, I had another look at code and it now looks like this and works fine.

modified code

Code: [Select]
var
  DestinationRect: TRect;
  bmpBGRA: TBGRACustomBitmap;
begin
    if ((FCurValue>=0) and (FCurValue<images.Count)) then FImages.GetBitmap(FCurValue,FForeImage)
    else if FCurValue<0 then FImages.GetBitmap(0,FForeImage)
         else FImages.GetBitmap(Fimages.Count-1,FForeImage);
    DestinationRect     := Rect(0,0, self.width, self.Height);
    canvas.CopyMode    := cmSrcCopy;
    bmpBGRA:=TBGRABitmap.create(FForeImage);
    bmpBGRA.ResampleFilter := rfMitchell;
    bmpBGRA.ResampleFilter:=rfBestQuality;
    bmpBGRA := bmpBGRA.Resample(self.Width, self.Height, rmFineResample) as TBGRABitmap;
    bmpBGRA.Draw(Canvas,0,0,false);  // Must use false for transparency
    with FForeImage do
    begin
      Clear;
      SetSize(self.Width,self.Height);
      Canvas.Draw(0,0,bmpBGRA.Bitmap);
    end;
    canvas.CopyRect(DestinationRect, FForeImage.Canvas, DestinationRect);
    bmpBgra.Free;
end;                 

It's probably not the neatest; and could do with some tidying; but for now it works; and will tidy up later...

Thanks Again

Josh
« Last Edit: February 09, 2017, 04:54:52 am by josh »
Development Installation Lazarus 1.3, FPC 2.7.1,Windows 7/8 32/64, OSX, *nix

Test Environment Lazarus & FPC Trunk on Windows and OSX (Cocoa Mainly on OSX). Testing also Crosscompile windows to OSX.. 
Any posts made from 2015 will be based on Lazarus Trunk.

Handoko

  • Hero Member
  • *****
  • Posts: 1404
  • My goal: build my own game engine using Lazarus
Re: Trying to Scale TBITMAP smoothly
« Reply #4 on: February 09, 2017, 04:15:07 pm »
Glad to know you have make it works.

Its nearly 4:00am and after a strong coffee, I had another look at code and it now looks like this and works fine.
>:( Please don't harm your health.

I know it's fun doing programming and 24 hours a day is just not enough for us. But I found that if I have enough sleep I can do program better.

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus