Kamerabilder vergleichen und nur bei "Bewegung" updaten?

[winx]

Hallo,

ist bes möglich 2 Bilder, die nacheinander im 500ms Abstand
mit einer Cam aufgenommen wurden zu vergleichen und die Anzeige
nur bei einer drastischen Veränderung (bzw Bewegung) zu ändern?

Gibt es da in Delphi nen schnellen Algorithmus?

danke,
winx

[Larsi]

Hi,
ja es gibt hier in der Delphi-Praxis so einen schnellen Algorithmus der zwei Bilder auf Unterschide untersucht:

Delphi-Quellcode:

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [0..50000000] of TRGBTriple;

function CompareImages(Image1,Image2:TBitmap):Int64;
var x,y:integer;
    P1,P2:PRGBTripleArray;
    summe1,summe2:integer;
begin
result := 0;
summe1 := 0;
summe2 := 0;
for y := 0 to Image1.Height -1 do
  begin
    P1 := Image1.ScanLine[y];
    P2 := Image2.ScanLine[y];
      if not CompareMem(p1,p2,Image1.Width*SizeOf(TRGBTriple)) then
        begin
          for x := 0 to Image1.Width-1 do
            begin
              inc(summe1,RGB(P1[x].rgbtRed,P1[x].rgbtGreen,P1[x].rgbtBlue));
              inc(summe2,RGB(P2[x].rgbtRed,P2[x].rgbtGreen,P2[x].rgbtBlue));
              if summe1 <> summe2 then
                begin
                  summe1 := 0;
                  summe2 := 0;
                  inc(result);
                end;
            end;
        end;
  end;
Application.ProcessMessages;
end;

Aufruf könnte so sein:
ShowMessage(IntToStr(CompareImages(Image1.Picture.Bitmap,Image2.Picture.Bitmap)));
Du musst dann halt das Webcambild abspeichern und in einem Image laden was aber auch ganz einfach geht:

Delphi-Quellcode:

function SaveWebcamPictureDIB(pFileName: PChar;WebcamHandle: THandle):Boolean;
const WM_CAP_FILE_SAVEDIB = WM_USER + 25;
begin
if IsWindow(WebcamHandle) then
  result := (SendMessage(WebcamHandle,WM_CAP_FILE_SAVEDIB,0,LPARAM(pFileName)) <> 0)
else
  result := false;
end;

Afuruf könnte dann so sein:
SaveWebcamPictureDIB(PChar('C:\test.jpg'),VideoHandle);
Dann ist es wenigstens schonmal abgespeichert, jetzt kannst du es ja über:
Image1.Picture.LoadFormFile('C:\test.jpg'); einfach laden und vergleichen!

Alles klar?

Der Code mit dem Speichern funktioniert nur wenn du das mit dem Webcam Stream über die Variante hier in der Codelib gemacht hast!


MFG Lars Wiltfang

[Corpsman]

ho larsi,

du machst das ja direckt über die RGB werte, evtl störungsunanfälliger wäre es wenn du über die Luminanze daten gehst.

und da nur abweichungen >= z.b. 0.1 wertest. Denn JPG ist da denke ich sonst zu anfällig. Und winx schreibt ja bei "Großer" abweichung.

Klar das er seinen Int64 Wert entsprechend mit was hohem vergleichen kann. das geht natürlich auch.

Ausprobieren würde ich das aber trotzdem.

man könnte z.b. Auch ne Prozentuale Abweichung angeben.

Also wenn er sein Ergebniss / (width*height) Teilt, oder so ...

[Larsi]

Er hätte mal suchen sollen, Delphi-Treff hat da auch was

[winx]

Hi,

danke schonmal

Sollte ich also das ganze mit den Luminazen oder deinen Algorithmus machen?
Wisst ihr, ob das auch mit TBitamp32 geht?

gruß,
winx

[Corpsman]

Klar geht das,

was da oben ja nicht steht ist das du
Bitmap.pixelformat := pf24Bit; machen must das der Algo tut.

und wenn du dann anstatt TRGBTripleArray einfach etwas der Art :

Delphi-Quellcode:

Type 
  PBGRA = ^TBGRA;
  TBGRA = Record
    Alpha : Byte;
    Blue : Byte;
    Green : Byte;
    Red : Byte;
  end;

Dann kannst du auch auf

Bitmap.pixelformat := pf32Bit; Zugreifen.

[winx]

danke,

werd ich mir mal angucken und mich dann wieder melden.

gruß

[winx]

Hi,

also ich habe jetzt den Code versucht:

Delphi-Quellcode:

type
  PRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array [0..50000000] of TRGBTriple;

function CompareImages(Image1,Image2:TBitmap):Int64;
var x,y:integer;
    P1,P2:PRGBTripleArray;
    summe1,summe2:integer;
begin
result := 0;
summe1 := 0;
summe2 := 0;
Image1.PixelFormat := pf24bit;
Image2.PixelFormat := pf24bit;

for y := 0 to Image1.Height -1 do
  begin

    P1 := Image1.ScanLine[y];
    P2 := Image2.ScanLine[y];
      if not CompareMem(p1,p2,Image1.Width*SizeOf(TRGBTriple)) then
        begin
          for x := 0 to Image1.Width-1 do
            begin
              inc(summe1,RGB(P1[x].rgbtRed,P1[x].rgbtGreen,P1[x].rgbtBlue));
              inc(summe2,RGB(P2[x].rgbtRed,P2[x].rgbtGreen,P2[x].rgbtBlue));
              if summe1 <> summe2 then
                begin
                  summe1 := 0;
                  summe2 := 0;
                  inc(result);
                end;
            end;
        end;
  end;
Application.ProcessMessages;
end;

Leider bekomme ich sogar bei Bildern ohne jegliche
Bewegung (also immer identisch) Werte von 280.000.

Woran kann das liegen?

Werde jetzt mal die Alpha Werte mit einbinden...

gruß