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:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls;

const
 MaxR = 256; // Genauigkeit
 MaxTheta = 256; // Genauigkeit

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Image2: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    Data: array[0..MaxTheta-1,0..MaxR-1] of DWord;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses math;

procedure TForm1.Button1Click(Sender: TObject);
var
 I, J, x, y: Integer;
 matches: array[0..1] of TPoint;
 value: DWord;
 ok: Boolean;
 c, s: Extended;
 mx, my: Integer;
 ex, ey, exy: Integer;
 p: PColor;
begin
  ex := Image1.Picture.Bitmap.Width;
  ey := Image1.Picture.Bitmap.Height;
  exy := max(ex,ey);
  mx := ex div 2;
  my := ey div 2;
  FillChar(Data, SizeOf(Data), 0);
  for y := 0-my to ey-my-1 do
   for x := 0-mx to ex-mx-1 do
    begin
     if Image1.Canvas.Pixels[x+mx,y+my] and $f8f8f8>0 then
      for I := 0 to MaxTheta-1 do
      begin
       sincos(I/MaxTheta*pi, s, c);
       J := Round(((x*c+y*s)/exy+1/2)*MaxR);
       if (J>=0) and (J<MaxR) then
        inc(Data[I,J]);
      end;
    end;
  for I := 0 to length(matches)-1 do
  begin
   value := 0;
   for x := 0 to MaxTheta-1 do
    for y := 0 to MaxR-1 do
     if Data[x,y]>value then
     begin
       ok := true;
       for J := 0 to I-1 do
        if sqr(matches[J].X-x)+sqr(matches[J].Y-y)<sqr(20) then
         ok := false; // nicht zu nahe an bekanntes Maximum
       if ok then
       begin
        value := Data[x,y];
        matches[I].X := x;
        matches[I].Y := y;
       end;
    end;
  end;
  for I := 0 to length(matches)-1 do
   with matches[I] do
   begin
    sincos(X/MaxTheta*pi, s, c);
    Image1.Canvas.Pen.Color := clRed;
    Image1.Canvas.MoveTo(round(c*(Y/MaxR-1/2)*exy+mx-s*exy),round(s*(Y/MaxR-1/2)*exy+my+c*exy));
    Image1.Canvas.LineTo(round(c*(Y/MaxR-1/2)*exy+mx+s*exy),round(s*(Y/MaxR-1/2)*exy+my-c*exy));
   end;

  Application.ProcessMessages;

  for x := 0 to MaxTheta-1 do
   for y := 0 to MaxR-1 do
    Image2.Canvas.Pixels[x,y] := min(255,data[x,y]*5);

end;

end.