SOLVED: Crop a jpg file and save it

[AsleyCruz]

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]

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][+][-]

1. var R : Trect;
2.  
3. procedure TForm1.Button1Click(Sender: TObject);
4. const MyCol = clBlue;
5. var x,y : integer;
6.     done : boolean;
7.  
8. begin
9.   // left
10.    done := false;
11.    for x := 0 to Image1.Width -1 do
12.       begin
13.         for y:= 0 to Image1.Height -1 do
14.           begin
15.           done := Image1.Canvas.Pixels[x,y] = myCol;
16.           if done then
17.              begin
18.              R.Left := x;
19.              showMessage (IntToStr(x));
20.              break;
21.              end
22.             end;// y
23.           if done then break;
24.       end; // x
25.     // top
26.   done := false;
27.    for y := 0 to Image1.height -1 do
28.       begin
29.         for x:= 0 to Image1.width -1 do
30.           begin
31.           done := Image1.Canvas.Pixels[x,y] = myCol;
32.           if done then
33.              begin
34.              R.top := y;
35.              showMessage (IntToStr(y));
36.              break;
37.              end
38.             end;// x
39.           if done then break;
40.       end; // y
41.  
42. // right
43. for x := Image1.Width -1 downto 0  do
44.       begin
45.         for y:= Image1.Height-1 downto 0 do
46.           begin
47.           done := Image1.Canvas.Pixels[x,y] = myCol;
48.           if done then
49.              begin
50.              R.right := x;
51.              showMessage (IntToStr(x));
52.              break;
53.              end
54.             end;// y
55.           if done then break;
56.       end; // x
57. // bottom
58.   done := false;
59.    for y := Image1.height -1 downto 0 do
60.       begin
61.         for x:= Image1.width -1 downto 0 do
62.           begin
63.           done := Image1.Canvas.Pixels[x,y] = myCol;
64.           if done then
65.              begin
66.              R.bottom := y;
67.              showMessage (IntToStr(y));
68.              break;
69.              end
70.             end;// x
71.           if done then break;
72.       end; // y
73. // The needed rectangle is in R
74. end;
75.  

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]

Hi!
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]

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]

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

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

[winni]

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]

Trumpish times.

Winni

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

Code: Pascal  [Select][+][-]

1. procedure TMainWin.ExampleClick(Sender: TObject);
2. // Pascal-style declarations
3. var
4.   i, j, minX, maxX, minY, maxY, red, grn, blu, tmp, dRows, dCols : integer;
5.   inImg, outImg: TBGRABitmap;
6.   sRect, dRect: TRect;
7.   P: PBGRAPixel;
8.  
9. begin
10.   red := 0;
11.   grn := 0;
12.   blu := 255;
13.   tol := 5; // Sets tolerance band
14.  
15.   // Initialize the limits
16.   minX := 9999999; // a big number
17.   minY := minX;
18.   maxX := -minX;
19.   maxY := -minY;
20.  
21.   // Load the image
22.   inImg := TBGRABitmap.Create('testimg.jpg');
23.  
24.   for i := 0 to inImg.Height - 1 do
25.   begin
26.     P := inImg.Scanline[i];
27.  
28.     for j := 0 to inImg.Width - 1 do
29.     begin
30.       if (InRange(P^.red, red - tol, red + tol)) and
31.           (InRange(P^.green, grn - tol, grn + tol)) and
32.           (InRange(P^.blue, blu - tol, blu + tol)) then
33.       begin
34.         minX := Min(j, minX);
35.         maxX := Max(j, maxX);
36.         minY := Min(i, minY);
37.         maxY := Max(i, maxY);
38.       end;
39.  
40.       Inc(P);
41.     end;
42.   end;
43.  
44.   // Set up source and dest rect
45.   sRect.Left := minX;
46.   sRect.Right := maxX;
47.   sRect.Top := minY;
48.   sRect.Bottom := maxY;
49.  
50.   dCols := 1 + maxX - minX;
51.   dRows := 1 + maxY - minY;
52.  
53.   dRect.Left := 0;
54.   dRect.Right := dCols - 1;
55.   dRect.Top := 0;
56.   dRect.Bottom := dRows - 1;
57.  
58.   outImg := TBGRABitmap.Create(dCols, dRows, 0);
59.   outImg.Canvas.CopyRect(dRect, inImg.Canvas, sRect);
60.   inImg.Free;
61.   outImg.SaveToFile('justblue.jpg');
62.   outImg.Free;
63. end;
64.