1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

procedure GetScreenShot (ABitmap : TBitmap);  stdcall;
var 
  DC : THandle; 
begin
  if Assigned(ABitmap) then
  begin 
    DC := GetDC(0);
    try
      ABitmap.Width := Screen.Width;
      ABitmap.Height := Screen.Height;
      BitBlt(ABitmap.Canvas.Handle,
             0,0,Screen.Width,Screen.Height,
             DC,
             0,0,
             SrcCopy
        ); 
    finally 
      ReleaseDC(0, DC);                       
    end; 
  end; 
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

function CompareColors(Color1, Color2, Tolerance: Integer): Boolean; stdcall;
var
  C1, C2: TColor;
begin
  Result := False;
  C1 := ColorToRGB(Color1);
  C2 := ColorToRGB(Color2);
  if (Abs(Round(GetRValue(C1) - GetRValue(C2))) <= Tolerance) then
    if (Abs(Round(GetGValue(C1) - GetGValue(C2))) <= Tolerance) then
      if (Abs(Round(GetBValue(C1) - GetBValue(C2))) <= Tolerance) then
        Result := True;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

for Scanhorizontal:=0 to Screen.width do
     begin
     for Scanvertical:=0 to Screen.height do
          begin
          //NUR PSEUDOCODE! Such dir bitte woanders wie du Pixelfarben vom Bildschirm auslesen kannst (3 Pixel im Beispiel)
          //Das ist aber nicht schwer ;-)
          If Pixelfarbe(Scanhorizontal,ScanVertical= Gesuchter 1.Pixel then
                begin
                If Pixelfarbe(Scanhorizontal+3,ScanVertical+3= Gesuchter 2.Pixel then     
                     begin
                     If Pixelfarbe(Scanhorizontal+6,ScanVertical+6= Gesuchter 3.Pixel then 
                          begin
                          //GEFUNDEN!!! Die Pixelanordnung entspricht der in der Grafik
            ...                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:

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

  TColorArray = array of array of Integer;

{...}

procedure GetColorArray(Bmp: TBitmap; var ColorArray: TColorArray);
var
  cx, cy: Integer;
  Line: PRGB32Array;
begin
  If Assigned(Bmp) then
  begin
    Bmp.PixelFormat := pf32bit;
    SetLength(ColorArray,Bmp.Width,Bmp.Height);
    for cy := 0 to Bmp.Height - 1 do
    begin
      Line := Bmp.ScanLine[cy];
      for cx := 0 to Bmp.Width - 1 do
      begin
        ColorArray[cx,cy] := RGB(Line[cx].R,Line[cx].G,Line[cx].B);
      end;
    end;
    Line := nil;
  end;
end;


function FindImage(Image: PChar; xs, ys, xe, ye, Tolerance: Integer; Pos: PPoint): Boolean; stdcall;
var
  searchImg: TBitmap;
  screenImg: TBitmap;
  searchColors, screenColors: TColorArray;
  ScanH, ScanV: Integer;
  SrchH, SrchV: Integer;
  Found, Finished: Boolean;
begin
  Result := False;
  Finished := false;
  If not FileExists(Image) then Exit;
  try
    searchImg := TBitmap.Create;
    searchImg.LoadFromFile(Image);
    screenImg := TBitmap.Create;
    GetScreenShot(screenImg);
    GetColorArray(searchImg,searchColors);
    GetColorArray(screenImg,screenColors);
    for ScanH := xs to xe do
    begin
    If Finished then Break;
      For ScanV := ys to ye do
      begin
      If Finished then Break;
        Found := true;
        For SrchH := 0 to SearchImg.Width - 1 do
        begin
          For SrchV := 0 to SearchImg.Height - 1 do
          begin
            If not CompareColors(screenColors[ScanH + SrchH,ScanV + SrchV],searchColors[SrchH,SrchV],Tolerance) then
              Found := false;
          end;
        end;
        If found then
        begin
          Pos^.X := ScanH;
          Pos^.Y := ScanV;
          Finished := true;
        end;
      end;
    end;
   finally
    FreeAndNil(searchImg);
    FreeAndNil(screenImg);
  end;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

function ComparePictures(Pic1, Pic2: TBitmap): Boolean;
var x, y: Integer;
begin
  // Das macht es leichter: Wenn irgendetwas nicht stimmt, wird einfach die Methode verlassen
  Result := False;

  // Natürlich müssen Breite und Höhe übereinstimmen
  if (Pic1.Width <> Pic2.Height) or (Pic1.Height <> Pic2.Height) then Exit;

  // Alle Pixel durchgehen und vergleichen; wenn Farbe unterschiedlich, Prozedur verlassen
  for x := 0 to Pic1.Width-1 do
    for y := 0 to Pic1.Height-1 do
      if Pic1.Pixels[x, y] <> Pic2.Pixels[x, y] then Exit;

  // Wenn der Code bis hier richtig ausgeführt wurde, sind die beiden Bilder wohl gleich
  Result := True;
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

      For ScanV := ys to ye do
      begin
      If Finished then Break;
        Found := true;
        For SrchH := 0 to SearchImg.Width - 1 do
        begin
          if not Found then
            Break;
          For SrchV := 0 to SearchImg.Height - 1 do
          begin
            If not CompareColors(screenColors[ScanH + SrchH,ScanV + SrchV],
              searchColors[SrchH,SrchV],Tolerance) then
            begin
              Found := false;
              Break;
            end;
          end;
        end;
        If found then
        begin
          Pos^.X := ScanH;
          Pos^.Y := ScanV;
          Finished := true;
          Result := True;
        end;
      end;