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

procedure GetScreenShot (var ABitmap : TBitmap); 
var 
  DC : THandle; 
begin 
  if Assigned(ABitmap) then                  // Prüfen ob gültiges Bitmap übergeben wurde 
  begin 
    DC := GetDC(0);                          // Desktop DC holen 
    try 
      ABitmap.Width := Screen.Width;           // Bitmapgrösse den... 
      ABitmap.Height := Screen.Height;         // Bildschirm anpassen 
      BitBlt(ABitmap.Canvas.Handle,            // Dekstop 
             0,0,Screen.Width,Screen.Height,   // in 
             DC,                               // das 
             0,0,                              // Bitmap 
             SrcCopy                           // kopieren 
        ); 
    finally 
      ReleaseDC(0, DC);                        // DC wieder freigeben 
    end; 
  end; 
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:
27:

procedure TfrmMain.Button4Click(Sender: TObject);
var
tempPoint: TPoint;
tempresult: TScanResult;
Width, Height: integer;
RotatedImage: TBitMap;
begin

  tempresult:=DrehVerschiebungsscan(Bild1,Bild2);   //Die Verschiebungskoordinaten und der Winkel werden bestimmt
  tempPoint:=tempresult.Koords;
  frmMain.Caption:=floattostr(tempresult.Winkel);

  Width:=Bild1.Width;
  Height:=Bild1.Height;

  RotatedImage:=TBitMap.Create;

  RotatedImage.Canvas.CopyRect(Rect(0,0,Width,Height),
  Bild2.Canvas,Rect(tempPoint.X, tempPoint.Y,
  tempPoint.X+Width,tempPoint.Y+Height));

  RotatedImage:=Rotate(RotatedImage ,-tempresult.Winkel);

  Image3.Picture.BitMap:=RotatedImage;  // das gefundene Bild wird in Image3 gemalt (zur zusätzlichen Kontrolle)

  RotatedImage.Free;
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:
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:

function DrehVerschiebungsscan(Bild1,Bild2 : TBitMap): TScanResult;
var
  i,k: Integer;
  bmp : TBitMap;
  Width: integer;
  Height: integer;
  Canv: TCanvas;
  Match: array[0..100] of ExtendedArray;
  tempPoint: TPoint;
  tempresult: TEvalResult;
  bmp1,bmp2: TBitMap;
begin

  bmp1:=Bild1;
  bmp2:=Bild2;

  for i := 0 to 100 do
  begin
    for k := 0 to 100 do
    Match[i,k]:=0;
  end;

  Width:=bmp1.Width;
  Height:=bmp1.Height;
  Canv:=bmp2.Canvas;

  bmp:=TBitMap.Create;
  bmp.Width:=Width;
  bmp.Height:=Height;


  for k := 0 to bmp2.Height-Height do
  begin

    for i := 0 to bmp2.Width-Width do
    begin
      bmp.Canvas.CopyRect(Rect(0,0,Width,Height), Canv,Rect(i,k,i+Width,k+Height));

      tempresult:=DrehEvaluate(bmp1,bmp);
      Match[i,k]:=tempresult.Match;
    end;
  end;

  tempPoint := Highest2dim(Match);

  bmp.Canvas.CopyRect(Rect(0,0,Width,Height),
  Canv,Rect(tempPoint.X, tempPoint.Y,tempPoint.X+Width, tempPoint.Y+Height));

  ShowMessage(floattostr(Evaluate(bmp,bmp1))+'% match');
  bmp.Free;

  result.Koords:=tempPoint;
  result.Winkel:=tempresult.Winkel;

end;					

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

function DrehEvaluate(b1,b2 : TBitmap) : TEvalResult;
var
tempMatch: array[0..11] of Extended;
tempbmp: TBitMap;
  i: Integer;
begin

  for i := 0 to 11 do
  begin
    tempbmp:=Rotate(b2,-i);
    tempMatch[i]:=EvaluateLila(tempbmp,b1);
    tempbmp.free;
  end;

    i:=Highest(tempMatch);
    result.Match:=tempMatch[i];
    result.Winkel:=i;

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:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:

function EvaluateLila(b1,b2 : TBitmap) : extended;
type
  TPixArray = Array[1..3] of Byte;
var
  SimilarR,SimilarG,SimilarB,i,x: integer;
  a,b : ^TPixArray;
begin

    b1.PixelFormat:=pf24bit;
    b2.PixelFormat:=pf24bit;

    SimilarR := 0;
    SimilarG := 0;
    SimilarB := 0;
  for i := 0 to b1.height-1 do
    begin
      a := b1.ScanLine[i];    //Bild1 scannen
      b := b2.ScanLine[i];    //Bild2 scannen
      for x := 0 to (b1.Width-1) do
      begin
        if (a^[1]=255) and (a^[2]=68) and (a^[3]=187) then
        begin
          inc(SimilarR);
          inc(SimilarG);
          inc(SimilarB);
        end

        else

        begin

          if a^[1] = b^[1] then          //R-Werte vergleichen
            inc(SimilarR);               //wenn gleich, Ähnlichkeitsanzahl erhöhen

          if a^[2] = b^[2] then          //G-Werte
            inc(SimilarG);

          if a^[3] = b^[3] then          //B-Werte
            inc(SimilarB);

        end;

          inc(a);                        //nächster Pixel...
          inc(b);

      end;
    end;

  result:=100*(SimilarR+SimilarG+SimilarB)/(3*((b1.Width)*(b1.Height)));
end;