Koordinaten auf Bild nicht richtig bestimmt

Cruentus · Hält's aus hier Beiträge: 9

Hallo allerseits.

Ich habe mir aus Codeschnipseln aus dem Netz ein Programm gebastelt, welches auf der linken Seite das aktuelle Bild der Webcam anzeigt und auf der rechten Seite einen Schnappschuss abbildet, der bei Druck auf einen Button gemacht wird. Das Bild soll dann auf die hellste Stelle hin untersucht werden (Addition der RGB-Werte), welche dann durch ein großes Kreuz markiert wird. Nun ist es aber so, dass diese Erkennung prinzipiell zwar funktioniert, aber die x-Koordinate nicht immer ganz richtig ist. je weiter die helle Stelle links ist, desto besser stimmt das Ergebnis, aber je weiter die Stelle rechts ist, desto weiter driftet der angebliche Fundort nach rechts ab. Die y-Komponente stimmt aber immer...

markieren

Delphi-Quelltext

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:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:

unit Videoauswertung;

interface

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

type
  PixArray = Array [1..3] of Byte;
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  handle2:THandle;
   i, j, x, y, R, G, B: integer;
  zwischensumme, endsumme: integer;
  
  p: ^PixArray;

const
  WM_CAP_DRIVER_CONNECT = WM_USER + 10;
  WM_CAP_EDIT_COPY = WM_USER + 30;
  WM_CAP_SET_PREVIEW = WM_USER + 50;
  WM_CAP_SET_OVERLAY = WM_USER + 51;
  WM_CAP_SET_PREVIEWRATE = WM_USER + 52;


implementation

{$R *.dfm}


function capCreateCaptureWindow(lpszWindowName: LPCSTR;  //ist für das Bildmachen zuständig
  dwStyle: DWORD;
  x, y,
  nWidth,
  nHeight: integer;
  hwndParent: HWND;
  nID: integer): HWND; stdcall;
  external 'AVICAP32.DLL' name 'capCreateCaptureWindowA';

procedure TForm1.Button1Click(Sender: TObject);  //Bild machen und analysieren
begin
  //Es wird ein Foto geschossen
  SendMessage( handle2, WM_CAP_EDIT_COPY, 1, 0 );
  Image1.Picture.Bitmap.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);

  //Automatische Erkennung des hellsten Punktes
  zwischensumme:=1;
  endsumme:=1;
  
  
  i:=0;
  j:=0;

  for i:=0 to image1.Picture.bitmap.Height-1 do
  begin
    p:= image1.Picture.bitmap.ScanLine[i];   //Zeile wird eingelesen

    for j:=0 to image1.Picture.Bitmap.Width-1 do
    begin
      B:=p^[1];
      G:=p^[2];
      R:=p^[3];
      zwischensumme:= R + G + B;    //Summe der RGB-WErte
        
      if zwischensumme > endsumme then
      begin
     
        endsumme:=zwischensumme;
        x:=j;
        y:=i;
      end;
      Inc(p);
    end;

  end;
  
  form1.image1.canvas.pen.color:=clRed;
  form1.Image1.Canvas.MoveTo(x,0);  //vertikaler Strich
  form1.Image1.Canvas.LineTo(x,480);
  form1.Image1.Canvas.MoveTo(0,y);  //waagerechter Strich
  form1.Image1.Canvas.LineTo(640,y);

  form1.Caption:='XY-Koordinaten: '+IntToStr(x)+' '+IntToStr(Y)+' Endsumme = '+IntToStr(endsumme);
end;

procedure TForm1.FormCreate(Sender: TObject);        //Videostream wird gestartet

begin
  handle2 := capCreateCaptureWindow('Video',ws_child+ws_visible, 0,
  0, 640, 480, Panel1.Handle, 1); //Wie du siehst, brauchst du ein Panel in diesem Beispiel ;-)
  SendMessage(handle2, WM_CAP_DRIVER_CONNECT, 0, 0);
  SendMessage(handle2, WM_CAP_SET_PREVIEWRATE, 30, 0);
  sendMessage(handle2, WM_CAP_SET_OVERLAY, 1, 0);
  SendMessage(handle2, wm_cap_set_preview, 1, 0);
end;

end.

Hat jemand eine Idee, woran das liegen könnte? Weiß nicht, ob das wichtig ist, aber ich hab einen Breitbildschirm (1440*900)...

turboPASCAL · Verfasst: Sa 04.09.10 20:26

markieren

Delphi-Quelltext

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:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:

unit Dingsbums;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    hCaptureWnd: THandle;
    RGBValue, MaxRGBValue: integer;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


const
  WM_CAP_DRIVER_CONNECT = WM_USER + 10;
  WM_CAP_EDIT_COPY = WM_USER + 30;
  WM_CAP_SET_PREVIEW = WM_USER + 50;
  WM_CAP_SET_OVERLAY = WM_USER + 51;
  WM_CAP_SET_PREVIEWRATE = WM_USER + 52;

function capCreateCaptureWindow(lpszWindowName: LPCSTR;  //ist für das Bildmachen zuständig
  dwStyle: DWORD;
  x, y,
  nWidth,
  nHeight: integer;
  hwndParent: HWND;
  nID: integer): HWND; stdcall;
  external 'AVICAP32.DLL' name 'capCreateCaptureWindowA';


procedure TForm1.Button1Click(Sender: TObject);  //Bild machen und analysieren
type
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[WORD] of TRGBTriple;
var
  px, py, x, y: integer;
  pPixelLine: pRGBTripleArray;
begin
  //Es wird ein Foto geschossen
  SendMessage( hCaptureWnd, WM_CAP_EDIT_COPY, 1, 0 );
  Image1.Picture.Bitmap.LoadFromClipboardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
  Image1.Picture.Bitmap.PixelFormat := pf24Bit;

  //Automatische Erkennung des hellsten Punktes

  MaxRGBValue := 0;
  RGBValue := 0;
  x := 0;
  y := 0;

  for py:=0 to image1.Picture.bitmap.Height-1 do
  begin
    pPixelLine:= image1.Picture.bitmap.ScanLine[py];   //Zeile wird eingelesen

    for px:=0 to image1.Picture.Bitmap.Width-1 do
    begin
      RGBValue := pPixelLine[px].rgbtRed + pPixelLine[px].rgbtGreen + pPixelLine[px].rgbtBlue;
      if RGBValue > MaxRGBValue then
      begin
        MaxRGBValue := RGBValue;
        x := px;
        y := py;
      end;
    end;
  end;

  with Image1.Picture.Bitmap do
  begin
    Canvas.pen.color:=clRed;
    Canvas.MoveTo(x, 0);  //vertikaler Strich
    Canvas.LineTo(x, 480);
    Canvas.MoveTo(0, y);  //waagerechter Strich
    Canvas.LineTo(640, y);
  end;

  Image1.Invalidate;

  Caption:= format('XY-Koordinaten: %d, %d', [x, y]);
end;

procedure TForm1.FormCreate(Sender: TObject);        //Videostream wird gestartet
begin
  hCaptureWnd := capCreateCaptureWindow('Video',ws_child+ws_visible, 0, 0, 640, 480,
    Panel1.Handle, 1);

  SendMessage(hCaptureWnd, WM_CAP_DRIVER_CONNECT, 0, 0);
  SendMessage(hCaptureWnd, WM_CAP_SET_PREVIEWRATE, 30, 0);
  sendMessage(hCaptureWnd, WM_CAP_SET_OVERLAY, 1, 0);
  SendMessage(hCaptureWnd, wm_cap_set_preview, 1, 0);
end;

end.

so, und was ist wenn es nun viele Pixel gibt die die gleiche Helligkeit haben ?

_________________
Nein, ich bin nicht der turboPASCAL aus der DP, ich seh nur so aus...

Cruentus · Hält's aus hier Beiträge: 9

WOW! Ich bin schlicht gesagt, baff! Es funktioniert wie geschmiert und ich muss zugeben, der Quellcode sieht nun um Welten besser aus als mein altes Geschmier

Woran lag es denn nun genau, dass die x-Koordinate immer verschoben war? War ich schuld, als ich das Pixelformat nicht über Image1.Picture.Bitmap.PixelFormat := pf24Bit; definiert habe?

So, und was die Pixel angeht: Ist nicht schlimm, wenn welche die gleiche Helligkeit haben. Ich setze vor die Webcam Fotofilm, da kommt nur Infrarotlicht durch (siehe Bild im Anhang). Und über die XY-Koordinaten wollte ich dann für ein größeres Projekt die Richtung bestimmen...

Testbild1

Einloggen, um Attachments anzusehen!

BenBE · Verfasst: So 05.09.10 02:08

Sieht interessant aus. Was wird das?

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

Cruentus · Hält's aus hier Beiträge: 9

ich versuche eine positionsbestimmung für einen rasenmäher-robo zu basteln. wollte im garten IR-Sender knapp über dem Erdboden aufstellen, die Position dann über die Webcam bestimmen und mittels Kreuzpeilung die endgültige Position bestimmen...

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme