Crop a bitmap to the given TBox.

[slacky]

Is there anyway to crop a bitmap in SCAR? I've been searching a lot, yet not found any solutions.

 

The secound function is the way I'm doing it now, but it's is simply to time consumung, but it's as fast as I could get it (for now).

{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=]
TBox = XS,YS, XE,YE
Speed?? I used 354ms @ 200x200px out of a bmp.
[=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
function CropBitmap(bmp:TSCARBitmap; cbox: TBox): TSCARBitmap;
var
 x,y: Integer;
 Res:TSCARBitmap; 
begin
 Res := TSCARBitmap.Create('');
 Res.SetSize(IAbs(cbox.X2-cbox.X1)+1, IAbs(cbox.Y2-cbox.Y1)+1);

 if cbox.X2 > bmp.Width  then cbox.X2 := bmp.Width-1;  
 if cbox.Y2 > bmp.Height then cbox.X2 := bmp.Height-1;

 for x:=cbox.X1 to cbox.X2 do
   for y:=cbox.Y1 to cbox.Y2 do
     Res.Pixels[x - cbox.X1, y - cbox.Y1] := BMP.Pixels[x,y];   

 Result := Res;
end;


{=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=]
Speed?? I used 290ms @ 200x200px out of a bmp.
[=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
function CropBitmap2(bmp:TSCARBitmap; cbox: TBox): TSCARBitmap;
var
 i,W,H,x,y,Size,modI: Integer;
 Res:TSCARBitmap;
 TIA: TIntArray;  
 TPA: TPointArray;
begin
 W:= IAbs(cbox.X2-cbox.X1)+1;
 H:= IAbs(cbox.Y2-cbox.Y1)+1; 

 Res := TSCARBitmap.Create('');
 Res.SetSize(W, H);

 if cbox.X2 > bmp.Width  then cbox.X2 := bmp.Width-1;  
 if cbox.Y2 > bmp.Height then cbox.Y2 := bmp.Height-1; 
 TPA := TPAFromBox(Box(cBox.X1,cBox.Y1, cBox.X2, cBox.Y2));
 TIA := Bmp.GetPixels(TPA); 

 x:=0; y:=0;     
 Size := W*H;
 for I:=0 to Size-1 do begin
   modI := I mod W;
   if (modI = 0) and (I > 0) then y:=y+1; 
   Res.Pixels[modI,y] := TIA[i];
 end;
 Result := Res;
end;

 

The second function is the fastest one... But it's not much differance... 88ms/10000px VS 72ms/10000px...

 

-----------------------

 

EDIT: I found the function "DrawTo" in the Wiki, but wasn't documented, but a little testing allowed me to understand how (I think) it works, it turned out to be pretty darn fast!

 

//Solution
function CropBitmap(bmp:TSCARBitmap; cbox: TBox): TSCARBitmap;
var
 W,H: Integer;
 Res: TSCARBitmap;
begin
 W:= IAbs(cbox.X2-cbox.X1)+1;
 H := IAbs(cbox.Y2-cbox.Y1)+1;

 Res := TSCARBitmap.Create(''); 
 Res.SetSize(W, H); 

 bmp.DrawTo(Res, -cbox.X1,-cbox.Y1); 
 Result := Res;
end;

Edited July 9, 2016 by slacky

[Janilabo]

Nice solution, mate!

*Drools for TSCARBitmap.Crop()*

[slacky]

Ty! Now I just need to look for a quicker way to turn the image in to a grayscale (luminance)-color T2DIntArray

[Janilabo]

About your CropBitmap() function, it can be shortened down to 3 lines:

 

function CropBitmap(bmp: TSCARBitmap; cbox: TBox): TSCARBitmap;
begin
 Result := TSCARBitmap.Create('');
 Result.SetSize(IAbs((cbox.X2 - cbox.X1) + 1), IAbs((cbox.Y2 - cbox.Y1) + 1));
 bmp.DrawTo(Result, -cbox.X1, -cbox.Y1);
end;

 

That way you don't even need to create extra bitmap (Res), as you can directly create the result bitmap and draw the stuff/data on it.

 

Going to add it in MSSL, this is fairly useful! Credits belong to you of course.

 

-Jani

Edited March 22, 2013 by Janilabo
Updated, thanks Freddy

[slacky]

Ofc, thank you for the feedback! I have yet to get used to some of the behavior in pascal (=

Edited March 22, 2013 by slacky

[FHannes]

Well, there isn't a built-in method, however, it can be done a lot faster than this. I also notice that your size calculations are off by 1 pixel. if X1 = X2, you calculate width 0, when in face, you have selected 1 pixel for the width.

 

Try this:

[scar]procedure CropBitmap(const Bmp: TSCARBitmap; const Box: TBox);

var

Tmp: TSCARBitmap;

begin

if (Box.X2 < Box.X1) or (Box.Y2 < Box.Y1) then

begin

WriteLn('Invalid box specified');

TerminateScript;

end;

 

Tmp := Bmp.Clone;

try

Bmp.SetSize(Box.X2 - Box.X1 + 1, Box.Y2 - Box.Y1 + 1);

Tmp.DrawTo(Bmp, -Box.X1, -Box.Y1);

finally

Tmp.Free;

end;

end;[/scar]

 

EDIT: Lol, looks like I had this window open from yesterday Didn't know it was solved already. But do note the 1 pixel difference, it's important.

[slacky]

That's a fine catch, Freddy! :-)

 

Also, I believe that your:

 if (Box.X2 < Box.X1) or (Box.Y2 < Box.Y1) then
 begin
   WriteLn('Invalid box specified');
   TerminateScript;
 end;

Is just a bit faster than a call (or two in my case) to IAbs. That would at least be the case in Python.

Edited March 22, 2013 by slacky

[Janilabo]

..also slacky, can you see what that smexy man added as a feature suggestion to Projects?

[FHannes]

That's a fine catch, Freddy! :-)

 

Also, I believe that your:

 if (Box.X2 < Box.X1) or (Box.Y2 < Box.Y1) then
 begin
   WriteLn('Invalid box specified');
   TerminateScript;
 end;

Is just a bit faster than a call (or two in my case) to IAbs. That would at least be the case in Python.

 

It's not faster actually, IAbs calls a core function, which is pure machine code, this executes a lot faster than processing all of the script code for the condition I've imposed, because the script engine isn't all that fast. But I've made it a convention not to allow "incorrect boxes".

[slacky]

Ahh. Yes, ofcourse!

 

As for your question, Janilabo: *edited* Yes, I noted that now, great! :-D

Edited March 22, 2013 by slacky