[Delphi][Source] FindColor(Tolerance) using ScanLines

[freddy1990]

Well, I notice many people do (no offence) a very newbish thing...
They use GetPixel for colorfinding functions...
Of course it works and it's good to learn it, but at a certain point you should move on to better techniques because GetPixel is incredibly slow.
It has to make an api call for every pixel.

I've quickly put together a function which uses scanlines.
A small explanation...
Colorfunctions that use scanlines get a complete bitmap of the client canvas and then get line by line rows of pixels to find a color in.

I've tried to comment it so it's clear how everything works and easier to use to make your own functions.
This is not the best technique, but it's good, fast and reliable.

function FindColor(var x, y: Integer; Color, xs, ys, xe, ye, Tolerance: Integer; Window: Hwnd): Boolean;
var
  Bmp: TBitmap; // Bitmap of the client
  tmpDC: HDC; // Device context of the client's window handle
  Size: TRect; // Rect(angle) of the client's window
  cx, cy: Integer; // For-loop vars
  Line: PRGB32Array; // The scanline
begin
  Result := False; // In case the color isn't found => Result = False
  x := -1; // In case the color isn't found => x = -1
  y := -1; // In case the color isn't found => y = -1
  Bmp := TBitmap.Create; // We create our bitmap instance
  tmpDC := GetWindowDC(Window); // We get the device context of the client's window handle
  GetWindowRect(Window, Size); // We get the rect(angle) of the client's window
  Bmp.Width := Size.Right - Size.Left; // We set the width of our bitmap
  Bmp.Height := Size.Bottom - Size.Top; // We set the height of our bitmap
  BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, tmpDC, 0, 0, SRCCOPY);
  // ^^^ We copy the client's canvas onto the bitmap
  Bmp.PixelFormat := pf32bit; // We set the bitmap to 32bits
  DeleteDC(tmpDC); // We delete the device context to avoid memory leakage
  for cy := ys to ye do // Loop for the rows of pixels (y)
  begin		  
	if cy >= Bmp.Height then Break; // Break the loop if you reach the end of the bitmap
	Line := Bmp.ScanLine[cy]; // We retrieve the scanline (line of pixels) from the bitmap for the current y
	for cx := xs to xe do // Loop for the colums of pixels (x)
	begin
	  if cx >= Bmp.Width then Break; // Break the loop if you reach the end of the bitmap
	  if (SimilarColors(RGB(Line[cx].R, Line[cx].G, Line[cx].B), Color, Tolerance)) then
	  // ^^^ We convert the RGB values of the current pixel to a color and compare it with the tolerance to the entered color
	  begin // If the color is similar (or for tol 0 the same) then...
		Result := True; // Result of the function
		x := cx; // Returned x-value
		y := cy;  // Returned y-value
		Line := nil; // Free the scanline to avoid memory leaks
		Bmp.Free; // Free the bitmap to avoid memory leaks
		Exit; // Exit the function
	  end;
	end;
  end;
  Line := nil; // Free the scanline to avoid memory leaks
  Bmp.Free; // Free the bitmap to avoid memory leaks
end;

For this function to work you will need 2 things, the following type declarations:

type
  TRGB32 = packed record
	B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
  PRGB32Array = ^TRGB32Array;

And this function:

function SimilarColors(Color1, Color2, Tolerance: Integer): Boolean;
begin
  Result := ((Abs((Color1 and $ff) - (Color2 and $ff)) <= Tolerance) and
	(Abs(((Color1 and $ff00) shr 8) - ((Color2 and $ff00) shr 8)) <= Tolerance) and
	(Abs(((Color1 and $ff0000) shr 16) - ((Color2 and $ff0000) shr 16)) <= Tolerance));
end;

I hope you can learn something from this, have fun