SOLVED: Crop a jpg file and save it
lazarus / 39-Graphics

----------------------------------------------------------------------
AsleyCruz · 2020-03-05 22:53

Hi team,

See attached image and help me please, to extract just the blue part.
We work with several images like this example but we don't have to do
this mannually each one.
For now, all images have the same position.

Hope it can be possible. Thanks team.

----------------------------------------------------------------------
winni · 2020-03-05 23:59

Hi!
Here we go:

Get the exact RGB Values of your blue sqare and assign them to the
const "MyCol"

Use this code to detect your blue square:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i var R :
Trect; procedure TForm1.Button1Click(Sender: TObject);const MyCol =
clBlue;var x,y : integer;    done : boolean; begin  // left   done :=
false;   for x := 0 to Image1.Width -1 do      begin        for y:= 0
to Image1.Height -1 do          begin          done :=
Image1.Canvas.Pixels[x,y] = myCol;          if done then           
 begin             R.Left := x;             showMessage
(IntToStr(x));             break;             end            end;// y 
        if done then break;      end; // x    // top  done := false; 
 for y := 0 to Image1.height -1 do      begin        for x:= 0 to
Image1.width -1 do          begin          done :=
Image1.Canvas.Pixels[x,y] = myCol;          if done then           
 begin             R.top := y;             showMessage (IntToStr(y)); 
           break;             end            end;// x          if done
then break;      end; // y // rightfor x := Image1.Width -1 downto 0
 do      begin        for y:= Image1.Height-1 downto 0 do         
begin          done := Image1.Canvas.Pixels[x,y] = myCol;          if
done then             begin             R.right := x;           
 showMessage (IntToStr(x));             break;             end       
   end;// y          if done then break;      end; // x// bottom  done
:= false;   for y := Image1.height -1 downto 0 do      begin       
for x:= Image1.width -1 downto 0 do          begin          done :=
Image1.Canvas.Pixels[x,y] = myCol;          if done then           
 begin             R.bottom := y;             showMessage
(IntToStr(y));             break;             end            end;// x 
        if done then break;      end; // y// The needed rectangle is
in Rend; 
Now you got the blue rectangle.

Create a TBitmap of the same dimension.
Make a canvas.copyrect from the blue rect to the bitmap.

Done.

Happy coding!
Winni

----------------------------------------------------------------------
AsleyCruz · 2020-03-06 00:22

Quote from: winni on March 06, 2020, 12:59:29 amHi!
Here we go:

Get the exact RGB Values of your blue sqare and assign them to the
const "MyCol"

Now you got the blue rectangle.

Create a TBitmap of the same dimension.
Make a canvas.copyrect from the blue rect to the bitmap.

Done.

Happy coding!
Winni

Hi winni, many thanks for your code. It is great but Im sorry, I think
I wasn't clear with the information.
I was referring to crop the jpg file using the position (left, top,
right, bottom) not the colors blue and yellow.


Please, see the new attached image and many thanks again.
(I will understand if you don't want to code it again anymore.)

Best regards

----------------------------------------------------------------------
winni · 2020-03-06 00:31

Hi!

Yes, I got you.

So again slowly:

My code detects the rectangle of your blue (or black) rectangle.

You create a Bitmap with the height and width of the rectangle.

You copy the rectangle to this new bitmap.

And now you save your bitmap.

Winni

----------------------------------------------------------------------
AsleyCruz · 2020-03-06 02:05

Quote from: winni on March 06, 2020, 01:31:40 amHi!

Yes, I got you.

So again slowly:

My code detects the rectangle of your blue (or black) rectangle.

You create a Bitmap with the height and width of the rectangle.

You copy the rectangle to this new bitmap.

And now you save your bitmap.

Winni

Ok, done, winni. Thanks for your time coding. A handshake

----------------------------------------------------------------------
winni · 2020-03-06 02:26

Nice that it works!

But: no handshake - that is said by all the hysteric TV shows!
You know : Everybody has now Corona!!!!

In Germany we have now 200 persons with Corona.
And 90.000 with influenza.

So there should be 90.000/200 times alarm about influenza.

Trumpish times.

Keep on hacking!

Winni

----------------------------------------------------------------------
del · 2020-03-06 03:47

Quote from: winni on March 06, 2020, 03:26:37 amTrumpish times.

Winni

I'm the guy who's Making Pascal Great Again. How about a robust
solution?

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i procedure
TMainWin.ExampleClick(Sender: TObject);// Pascal-style
declarationsvar  i, j, minX, maxX, minY, maxY, red, grn, blu, tmp,
dRows, dCols : integer;  inImg, outImg: TBGRABitmap;  sRect, dRect:
TRect;  P: PBGRAPixel; begin  red := 0;  grn := 0;  blu := 255;  tol
:= 5; // Sets tolerance band   // Initialize the limits  minX :=
9999999; // a big number  minY := minX;  maxX := -minX;  maxY :=
-minY;   // Load the image  inImg :=
TBGRABitmap.Create('testimg.jpg');   for i := 0 to inImg.Height - 1
do  begin    P := inImg.Scanline[i];     for j := 0 to inImg.Width - 1
do    begin      if (InRange(P^.red, red - tol, red + tol)) and      
  (InRange(P^.green, grn - tol, grn + tol)) and         
(InRange(P^.blue, blu - tol, blu + tol)) then      begin        minX
:= Min(j, minX);        maxX := Max(j, maxX);        minY := Min(i,
minY);        maxY := Max(i, maxY);      end;       Inc(P);    end; 
end;   // Set up source and dest rect  sRect.Left := minX; 
sRect.Right := maxX;  sRect.Top := minY;  sRect.Bottom := maxY;  
dCols := 1 + maxX - minX;  dRows := 1 + maxY - minY;   dRect.Left :=
0;  dRect.Right := dCols - 1;  dRect.Top := 0;  dRect.Bottom := dRows
- 1;   outImg := TBGRABitmap.Create(dCols, dRows, 0); 
outImg.Canvas.CopyRect(dRect, inImg.Canvas, sRect);  inImg.Free; 
outImg.SaveToFile('justblue.jpg');  outImg.Free;end;