PixelSearch function is very inefficient, how can I optimize it?

Question

I currently take screenshots of an area in a loop to then search for 4 pixels in it. Those pixels do have the same color - red or $001300FF . The variables that are used are defined and initialized in the OnCreate event:

//The variables for the area:
ScanL := 500; // Left
ScanR := 800; // Right
ScanT := 180; // Top
ScanB := 400; // Bottom

screenshot: TBitMap;
canvas : TCanvas;

To take the screenshots I use the following function:

procedure TFormMain.GetSCREENSHOT(var a: TBitMap);
var
  Locked: Boolean;
begin
  Locked := Canvas.TryLock;
  try
    screenshot.Canvas.CopyRect(screenshot.Canvas.ClipRect, Canvas, Rect(ScanL, ScanT, ScanR, ScanB)); 
  finally
    if Locked then
      Canvas.Unlock;
  end;
end;

The variable "screenshot : TBitMap", globally defined gets passed to the GetSCREENSHOT-function. To search for those 4 pixels I just did what a newbie would do:

   function TFormMain.findImage : Boolean;
    var
      x,y : Integer;
    begin
      Result := false;
      for x := 0 to screenshot.Width-10 do
      begin
        for y := 0 to screenshot.Height-10 do
        begin
          if screenshot.Canvas.Pixels[x,y] = $001300FF then
          begin
            if screenshot.Canvas.Pixels[x,y+1] = $001300FF then
              if screenshot.Canvas.Pixels[x,y+2] = $001300FF then
                if screenshot.Canvas.Pixels[x,y+3] = $001300FF then
                begin
                  FoundPixelX := ScanL + x;
                  FoundPixelY := ScanT + Y;
                  Result := True;
                  Exit;
                end;
          end;
        end;
      end;
    end;

Because it performed so bad, I measured how long it takes to run the function:

  QueryPerformanceFrequency(freq);
  QueryPerformanceCounter(startTime);

  findImage;

  QueryPerformanceCounter(endTime);
  ShowMessage('the function needs about ' + IntToStr((endTime - startTime) * 1000 div freq) + 'ms');

and it takes 108ms! That's crazy. I don't know why and I hope you can help me how to improve it! I thought that it maybe has something to do with the access of the .Pixels property ?!

To compare: getSCREENSHOT takes less than 1ms.

Answer 1

Speeding the scan up can be done in a few ways.
First of all, avoid the call to pixels. Whilst convenient it is notoriously slow.
Call scanline instead. This gives you direct access to the raw data of the bitmap.

The second step would be to optimize your search loop.
When looping pixels always put the x dimension in the inner loop.
Because I am looking for 4 identically colored pixels I can use a simple Knuth–Morris–Pratt like optimization and increase y by 4 each loop (See below).
If I'm looking for 4 pixels with different colors, the actual code for this optimization gets a lot more complex.

{$pointermath on}

function TFormMain.findImage : Boolean;
var
  ScanLine, NextScanLine: PInteger;
  Stride: integer;
  MaxX: integer;
const
  MinX = 0;
  BytesPerPixel = SizeOf(integer);
  MagicColor = $001300FF; 
begin
  MaxX:= Screenshot.Width - 10;
  Assert(Screenshot.PixelFormat = pf32bit);
  Result := false;
  ScanLine:= Screenshot.ScanLine[0];
  Stride:= (NativeInt(Screenshot.ScanLine[1]) - NativeInt(ScanLine)) div BytesPerPixel; 
  y := 0
  repeat
    NextScanLine:= @ScanLine[Stride]; 
    for x:= MinX to MaxX do begin
      if (ScanLine[0] = MagicColor) then begin
        if (ScanLine[stride] = MagicColor) then begin
          if (ScanLine[stride*2] = MagicColor) then begin
            if (ScanLine[stride*3] = MagicColor) then begin
              FoundPixelX := ScanL + x;
              FoundPixelY := ScanT + Y;
              Exit(True);
            end;
          end;
        end;
      end;
      Inc(ScanLine);
    end; {for x}
    ScanLine:= NextScanLine;
    Inc(y);
  until (y > (Height - 10));
end;

Caveats
Note that scanline[0] and scanline[1] do not necessarily differ by Width * BytePerPixel. Windows sometimes put a bit of slack in the bitmap data for alignment reasons. This is why I test the difference between two scanlines.
In the loop itself I never call scanline this is another optimization.

Further optimization: Battleship to the rescue
If you are looking for four identical pixels (i.e. your fav tint of red). you only need to scan 1 out of every 4 scanlines. As soon as you find a red pixel, look up and down (as you would in the classic game: Battleship) to see if you have a line of 4 red pixels.
If so you've found a match.

In this case the inner loop becomes:

//Start with ScanLine[3]: the fourth scanline {we start at 0}
NextScanLine:= @ScanLine[Stride*4]; 
for x:= MinX to MaxX do begin
  if (ScanLine[0] = MagicColor) then begin
    Count:=   (integer(ScanLine[-stride*3] = MagicColor) * 1 
             + integer(ScanLine[-stride*2] = MagicColor) * 2
             + integer(ScanLine[-stride*1] = MagicColor) * 4
             + 8; //The line itself
    case Count of  
      1+2+4+8: begin
        FoundPixelX := ScanL + x;
        FoundPixelY := ScanT + Y-3;
        Exit(True);
      end;
      4+8+16: if (ScanLine[stride] = MagicColor) then begin
        FoundPixelX := ScanL + x;
        FoundPixelY := ScanT + Y-2;
        Exit(True);
      end;
      8+16, 1+8+16: if (ScanLine[stride] = MagicColor) and
                       (ScanLine[stride*2] = MagicColor) then begin
        FoundPixelX := ScanL + x;
        FoundPixelY := ScanT + Y-1;
        Exit(True);
      end;
    end; {case}
    if   (ScanLine[stride] = MagicColor) and
         (ScanLine[stride*2] = MagicColor) and
         (ScanLine[stride*3] = MagicColor) then begin
      FoundPixelX := ScanL + x;
      FoundPixelY := ScanT + Y;
      Exit(True);
    end;
  end;
  Inc(ScanLine);
end; {for x}
ScanLine:= NextScanLine;
Inc(y);

In the optimized version I'm using a bit of trickery to simplify speed up the logic to test for a match.
First I abuse the fast that true = 1 and false = 0 to convert the match to an integer.
Then I use the fact that consecutive bits have values 1,2,4,8 etc to keep track of the red matches. I only do further tests if they are needed.

I could limit the number of memory-accesses further, but this would come at the costs of more tests. In the code Delphi generates tests are usually a (tiny) bit more expensive than memory accesses, so I've erred towards the later.

Knuth-Morris-Pratt
If you are looking for 4 different pixels that trick will not work and you'll need to implement more complex code.
Complexity costs CPU cycles, so I doubt using Knuth-Morris-Pratt will help.
That particular algorithm works better as your search 'string' gets longer. Having only four 'chars' in your search string is not enough to make it shine.