ImageEn for Delphi and C++ Builder ImageEn for Delphi and C++ Builder

 

ImageEn Forum
Profile    Join    Active Topics    Forum FAQ    Search this forumSearch
 All Forums
 ImageEn Library for Delphi, C++ and .Net
 ImageEn and IEvolution Support Forum
 Need EXTREMELY FAST graphic algorithm

Note: You must be registered in order to post a reply.
To register, click here. Registration is FREE!

View 
UserName:
Password:
Format  Bold Italicized Underline  Align Left Centered Align Right  Horizontal Rule  Insert Hyperlink   Browse for an image to attach to your post Browse for a zip to attach to your post Insert Code  Insert Quote Insert List
   
Message 

 

Emoji
Smile [:)] Big Smile [:D] Cool [8D] Blush [:I]
Tongue [:P] Evil [):] Wink [;)] Black Eye [B)]
Frown [:(] Shocked [:0] Angry [:(!] Sleepy [|)]
Kisses [:X] Approve [^] Disapprove [V] Question [?]

 
Check here to subscribe to this topic.
   

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