T O P I C R E V I E W |
PeterPanino |
Posted - Dec 07 2016 : 17:52:46 I need an EXTREMELY FAST algorithm in Delphi 10.1 Berlin:
Inside a Rectangle on a Bitmap, retrieve the rightmost color which is not clWhite (the result is Blue in this case):
I've tried to implement this with Canvas.Pixels, but it is too slow. I am sure there are gurus who could indicate me a direction for this problem. I use ImageEn already, but I am not sure which part of the library I could use to solve this problem. Could this also be improved by using threads? |
8 L A T E S T R E P L I E S (Newest First) |
spetric |
Posted - Dec 13 2016 : 09:08:59 Hi Peter,
I don't have any experience with TParallel.For, because I work with XE5. |
PeterPanino |
Posted - Dec 09 2016 : 17:55:11 Thank you very much for your improvement ideas!
My idea was to maybe use TParallel.For for the inner loop. What do you think? |
spetric |
Posted - Dec 09 2016 : 15:56:45 Hi Peter,
You may speed up existing code by adding if x < ThisMax before checking color. If it's lower, then break, because obviously there is some rightmost color already found and there is no need to proceed with "x loop".
Second improvement may be to perform vertical sweeping, i.e. to invert outer and inner loop. First pixel found with color <> white, you're done. Some kind of meta code would be:
for (x = boundRect.right downto boundRect.left)
{
for (y = boundRect.top to boundRect.bottom)
{
if (color(y,x) is not white)
return color(y,x); // done, exit the function
}
}
Oh yes, one thing left: parallelism. If you have big image and big bounding rectangle, you can split inner loop in two halves and run them in separate threads.
|
PeterPanino |
Posted - Dec 09 2016 : 07:56:22 Can this be optimized by TParallel.For? |
PeterPanino |
Posted - Dec 09 2016 : 07:07:00 OK, that one was late in the night. ;-)
Here is the working thing:
function TForm2.GetRightMostNonWhiteColorInRectangle(const ABitmap: TIEBitmap; const ARectangle: TRect): TColor;
var
x, y: Integer;
px: hyiedefs.PRGB;
ThisMax: Integer;
begin
Result := 16777215; // clWhite
ThisMax := -1;
for y := ARectangle.Top to ARectangle.Bottom do // loop lines
begin
px := TestBM.Scanline[y]; // points to first pixel in the WHOLE bitmap!
Inc(px, ARectangle.Right); // go to the pixel of the right side of the rectangle
for x := ARectangle.Right downto ARectangle.Left do // loop pixels down to left side of rectangle
begin
with px^ do // check this pixel
begin
if (r <> 255) or (g <> 255) or (b <> 255) then // Found NonWhite Pixel
begin
//CodeSite.Send('RGB(r, g, b)', RGB(r, g, b));
if x >= ThisMax then // if this pixel is more or equal rightmost than the previous rightmost
begin
ThisMax := x; // store this pixel position
Result := RGB(r, g, b);
end;
BREAK; // go to the next scanline
end;
end;
Dec(px); // NonWhite pixel not found -> go to previous pixel
end;
end;
end;
|
PeterPanino |
Posted - Dec 08 2016 : 19:40:11 I tried this one:
var
TestBM: TIEBitmap;
procedure TForm2.FormCreate(Sender: TObject);
begin
TestBM := TIEBitmap.Create;
TestBM.Read('colors.bmp'); // above image converted to .bmp, see attached file
end;
procedure TForm2.Button1Click(Sender: TObject);
var
TestRect: TRect;
begin
TestRect.Left := 24;
TestRect.Top := 117;
TestRect.Right := 450;
TestRect.Bottom := 214;
GetRightMostNonWhiteColorInRectangle(TestBM, TestRect);
end;
function TForm2.GetRightMostNonWhiteColorInRectangle(const ABitmap: TIEBitmap; const ARectangle: TRect): TColor;
var
x, y: Integer;
px: hyiedefs.PRGB;
begin
Result := clWhite;
for y := ARectangle.Top to ARectangle.Bottom do // loop lines
begin
px := TestBM.Scanline[y];
for x := ARectangle.Right downto ARectangle.Left do // loop pixels
begin
with px^ do
begin
if (r <> 255) and (g <> 255) and (b <> 255) then // Found NonWhite Pixel
CodeSite.Send('x', x); // sent by all pixels regardless whether they are white or non-white!!! <<<<<<<<<<<<<<<<<<<<<<
end;
end;
end;
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
if Assigned(TestBM) then
TestBM.Free;
end;
The condition if (r <> 255) and (g <> 255) and (b <> 255) then is met by ALL scanned pixels regardless whether they are white or non-white! What am I doing wrong?
attach/PeterPanino/2016128195636_colors.zip 5.84 KB |
spetric |
Posted - Dec 08 2016 : 09:21:28 I'm not well versed Delphi programmer, but I'll give a shot. Code is not tested, it's written "ah hoc", pointer arithmetic is little clumsy, but you'll get a general idea:
function GetRightMostColor(var map: TIEBitmap; TRect boundRect): TColor;
type
PByte = ^Byte;
var
i,j,k, rightMax: Integer;
testColor: Integer;
whiteColor: Integer;
inByteP: PByte;
begin
whiteColor := 255255255;
rightMax := 0;
for i := boundRect.top to boundRect.bottom do
begin
inByteP := map.ScanLine[i];
inByteP := Inc(inByteP, boundRect.right * 3); // 3 channels => RGB
for j := boundRect.right Downto boundRect.left do
begin
testColor := 0;
// channels are actually in BGR order.
Dec(inByteP);
testColor := testColor + (Integer(inByteP^)shl 16); // red
Dec(inByteP);
testColor := testColor + (Integer(inByteP^)shl 8); // green
Dec(inByteP);
testColor := testColor + Integer(inByteP^); // blue
if (testColor <> whiteColor) then
begin
if ( j > rightMax) then
rightMax := j;
Break; // exit j loop
end;
end;
end;
Result = TColor(testColor);
end;
|
xequte |
Posted - Dec 08 2016 : 03:39:43 Hi Peter
Yes, Pixels would be too slow. Use ScanLine instead.
http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Graphics_TBitmap_ScanLine.html
Nigel Xequte Software www.xequte.com nigel@xequte.com
|
|
|