Hi Leute,

ich sitze jetzt die halbe Nacht und irgendwie werde ich nicht schlau daraus. Vielleicht könnt ihr mir da weiter helfen.
Also die Grundaufgabe ist ein Bildausschnitt in einem großem Bild zu suchen.

Die einfache Abarbeitung dauert ca.12 sec bei extrem großen Bildern. Nun kam mir die Idee das Bild aufzuteilen und mit einzelnen Threads Mehrkern-Prozessor besser auszulasten
und somit eine erhöhte Geschwindigkeit zu erreichen.

Also TThread Klasse benutzt. Sie läuft auch sauber durch nur ist sie etwas langsamer als die normale Abarbeitung.

Ich habe es folgendermaßen getestet. Ich habe zwei kleine Bildauschnitte die in dem großen Bild gesucht werden. Also habe ich 4 Bitmaps erstellt.
1 suchbitmap und ein Bitmap in dem gesucht wird für jeder thread. da es 2 Threads sind auch 2x2 Bitmaps. Gedanke: " Sie kommen sich nicht in die Quere und können gleichzeitig suchen.

Hier mal die Thread unit

zusammenfalten · markieren

Delphi-Quellcode:

unit imgCompareThread;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls,
  Vcl.Menus,Vcl.ImgList,SelectKit,picturehelper;

type
  TImageSearch = class(TThread)
  private
    { Private-Deklarationen }
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended : boolean ;var SearchBMP,ScreenBMP : TBitmap;var xyPoint : TPoint);overload;
  end;

implementation

{ TImageSearch }

procedure TImageSearch.Execute;
begin
{ Thread-Code hier einfügen }
  NameThreadForDebugging(AnsiString(inttostr(GetTickCount)));
end;

constructor TImageSearch.Create(CreateSuspended: Boolean; var SearchBMP: TBitmap; var ScreenBMP: TBitmap;var xyPoint: TPoint);
var
  x,y: Integer;
  tempBMP : Tbitmap;
  rectSource,rectDest : TRect;
  toBreak : boolean;
  i: Integer;
  k: Integer;
begin
  inherited Create (CreateSuspended) ;
  toBreak := false;
  // ******************************************************************************
  // oben links suchen
  // ******************************************************************************
  Try
    //showMessage('Suche');
    FreeOnTerminate := true;
    // Declaration
    tempBMP := Tbitmap.Create;
    tempBMP.Width := SearchBMP.Width;
    tempBMP.Height := SearchBMP.Height;
    tempBMP.PixelFormat := SearchBMP.PixelFormat;
    for x := 0 to ScreenBMP.Width-tempBMP.Width-1 do
      begin
        if toBreak then break;
        for y := 0 to ScreenBMP.Height-tempBMP.Height-1 do
        begin
          // Ausschnittsbereich festlegen
          rectDest := rect(0,0,tempBmp.Width,tempBmp.Height);
          rectSource := rect(x,y,x+tempBmp.Width,y+tempBmp.Height);
          tempBmp.Canvas.CopyMode := cmSrcCopy;
          // Ausschnittsbereich kopieren rectSource
          tempBmp.Canvas.CopyRect(rectDest,ScreenBMP.Canvas,rectSource);
          //imgTemp.Picture.Bitmap.Assign(tempBMP);
          if Compare2Bitmaps(80,SearchBMP,tempBMP) = ceOK then
            begin
              //Label1.Caption := 'Zeit: '+FloatToStr((GetTickCount - startTime)/1000)+' s';
              toBreak := true;
              //showMessage(inttostr(x)+'-'+inttostr(y));
              xyPoint.X := x;
              xyPoint.Y := y;
              break;
            end;
        end;
      end;
  Finally
    tempBMP.Free;
  End;
end;

end.

und hier der Aufruf aus dem MainPart

zusammenfalten · markieren

Delphi-Quellcode:

var
  k : integer;
  aktScreen1,aktScreen2 : TBitmap;
  suchbild1,suchbild2 : TBitmap;
begin
  Try
    fstarttimer := GetTickCount;
    aktScreen1 := TBitmap.Create;
    aktScreen2 := TBitmap.Create;
    suchbild1 := TBitmap.create;
    suchBild2 := TBitmap.Create;
    ScreenCapture(aktScreen1);
    ScreenCapture(aktScreen2);

    suchbild1.LoadFromFile('C:\Users\s0n\Documents\Delphi\gw2item_neu\Win32\Debug\i1.bmp');
    suchBild2.LoadFromFile('C:\Users\s0n\Documents\Delphi\gw2item_neu\Win32\Debug\i2.bmp');
    ThreadsRunning := 2;

    with TImageSearch.Create(false,suchbild1,aktScreen1,xyPoint1) do
      begin
        OnTerminate := ThreadDone;
      end;
    with TImageSearch.Create(false,suchbild2,aktScreen2,xyPoint2) do
      begin
        OnTerminate := ThreadDone;
      end;

  Finally
    suchbild1.Free;
    suchbild2.Free;
    aktScreen1.Free;
    aktScreen2.Free;
  End;

Wo liegt das Problem? Ich habe auch schon probiert mir propertys die Parameter ganz normal zu übergeben und danach zu starten. Führte aber zu keiner Besserung.

Ich hoffe ihr könnt mir auf die Sprünge helfen, da ich den eindruck habe er arbeitet es nacheinander ab.

Grüße s0n

Es sieht für mich so aus, als würde dein Code im Create anstatt in der Execute Methode des Threads ausgeführt werden.

Außerdem musst du mit dem Freigeben der Ressourcen warten bis die Threads fertig sind und das sind sie mit hoher Wahrscheinlichkeit nicht, wenn du im Finally-Block angekommen bist.

Du hast den Arbeitscode in die Create-Routine des Thread geschrieben, so wird der natürlich auch darin ausgeführt. Die Stelle ist als { Thread-Code hier einfügen } markiert.

Der Code gehört nach Execute!

Außerdem musst Du dafür sorgen, dass während der Verarbeitung die temporären Objekte weiter existieren und nicht in der aufrufenden Routine zerstört werden (fertige die Kopien in Create an).

Code im Konstruktor eines TThread Objekts wird im Kontext des aufrufenden Threads (üblicherweise der Main-Thread) ausgeführt.

Außerdem sehe ich kein Start oder Resume Aufruf außerhalb des Threads.

Ist das denn nötig? Soweit ich gesehen habe steht CreateSuspended ja auf false.

Zitat von sonny2007:

Hi Leute,

ich sitze jetzt die halbe Nacht und irgendwie werde ich nicht schlau daraus.

Das kenne ich...

Ins Bett gehen... Nach dem 1. Kaffee den Code in die Execute verschieben und feststellen, es war gestern doch zu spät für so eine Routine...

Mavarik

Mal abgesehen von der falschen Verwendung von Threads...

Das Kopieren eines Ausschnitts der ScreenBMP in die tempBmp ist hier der eigentlich bremsende Faktor.
Es erscheint mir sinnvoller die Funktion "Compare2Bitmaps" so anzupassen, dass statt zwei kompletter Bitmaps, nur der angegebene Bereich verglichen wird.

Compare2Bitmaps(80, SearchBMP, ScreenBMP, rectSource);

hiho,

mmhhhhhh.........

also ich habe es jetzt so abgeändert.

in formCreate

markieren

Delphi-Quellcode:

aktScreen1 := TBitmap.Create;
  aktScreen2 := TBitmap.Create;
  suchbild1 := TBitmap.create;
  suchBild2 := TBitmap.Create;

  suchbild1.LoadFromFile('C:\Users\blabla\Pictures\i1.bmp');
  suchBild2.LoadFromFile('C:\Users\blabla\Pictures\2.bmp');

dann der Thread Aufruf vom Button

zusammenfalten · markieren

Delphi-Quellcode:

procedure TfrmMain.searchInventar(Sender: TObject);
begin
  fstarttimer := GetTickCount;
  ScreenCapture(aktScreen1);
  ScreenCapture(aktScreen2);
  ThreadsRunning := 2;

  // Threads erzeugen aber nicht ausführen
  Thread1 := TImageSearch.Create(true);
  Thread1.OnTerminate := ThreadDone1;
  Thread1.Searchbmp.Assign(suchbild1);
  Thread1.screenbmp.Assign(aktScreen1);
  Thread1.NameThreadForDebugging('Thread1');

  Thread2 := TImageSearch.Create(true);
  Thread2.OnTerminate := ThreadDone2;
  Thread2.Searchbmp.Assign(suchbild2);
  Thread2.screenbmp.Assign(aktScreen2);
  Thread2.NameThreadForDebugging('Thread2');

  // Threads starten
  Thread1.start;
  Thread2.start;
end;

Und hier der komplette thread Part

zusammenfalten · markieren

Delphi-Quellcode:

unit imgCompareThread;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ComCtrls,
  Vcl.Menus,Vcl.ImgList,SelectKit,pictureHelper;

type
  TImageSearch = class(TThread)
  private
    fScreenBMP : TBitmap;
    fSearchBMP : TBitmap;
    fxyPoint : Tpoint;
    { Private-Deklarationen }
  protected
    procedure Execute; override;
  public
    //constructor Create(CreateSuspended : boolean ;var SearchBMP,ScreenBMP : TBitmap;var xyPoint : TPoint);overload;
    constructor Create(CreateSuspended: boolean); overload;
    property ScreenBMP : TBitmap read FScreenBMP write FScreenBMP;
    property SearchBMP : TBitmap read FSearchBMP write FSearchBMP;
    property xyPoint : TPoint read fxyPoint write fxyPoint;
  end;

implementation

{ TImageSearch }

procedure TImageSearch.Execute;
var
  x,y: Integer;
  tempBMP : Tbitmap;
  rectSource,rectDest : TRect;
  toBreak : boolean;
  i: Integer;
  k: Integer;
begin
  toBreak := false;
  // ******************************************************************************
  // Inventar oben links suchen
  // ******************************************************************************
  Try
    // Declaration
    tempBMP := Tbitmap.Create;
    tempBMP.Width := FSearchBMP.Width;
    tempBMP.Height := FSearchBMP.Height;
    tempBMP.PixelFormat := FSearchBMP.PixelFormat;
    for x := 0 to FScreenBMP.Width-tempBMP.Width-1 do
      begin
        if toBreak then break;
        for y := 0 to FScreenBMP.Height-tempBMP.Height-1 do
        begin
          // Ausschnittsbereich festlegen
          rectDest := rect(0,0,tempBmp.Width,tempBmp.Height);
          rectSource := rect(x,y,x+tempBmp.Width,y+tempBmp.Height);
          tempBmp.Canvas.CopyMode := cmSrcCopy;
          // Ausschnittsbereich kopieren rectSource
          tempBmp.Canvas.CopyRect(rectDest,ScreenBMP.Canvas,rectSource);
          //imgTemp.Picture.Bitmap.Assign(tempBMP);
          if Compare2Bitmaps(60,FSearchBMP,tempBMP) = ceOK then
            begin
              toBreak := true;
              fxypoint.x := x;
              fxypoint.y := y;
              with Tform.Create(nil) do
                begin
                  FormStyle := fsStayOnTop;
                  Name := 'frmSelection2';
                  Position := poDesigned;
                  left := x-3;
                  top := y-3;
                  Width := 56;
                  Height := 56;
                  borderstyle := bsNone;
                  color := clWhite;
                  for k := 0 to 5 do
                    begin
                      visible := true;
                      sleep(100);
                      visible := false;
                      sleep(100);
                    end;
                  free;
                end;
              break;
            end;
        end;
      end;
  Finally
    tempBMP.Free;
  End;
end;

constructor TImageSearch.Create(CreateSuspended: Boolean);
begin
  fScreenBMP := TBitmap.Create;
  fSearchBMP := TBitmap.Create;
  inherited Create(CreateSuspended);
end;


end.

im OnTerminate wollte ich die XY Points holen doch die geben leider immer null zurück.

markieren

Delphi-Quellcode:

Dec(ThreadsRunning);
  xyPoint2 := Thread2.xyPoint;
  showMessage('X2: ' +inttostr(Thread2.xyPoint.X)+' Y2: '+inttostr(Thread2.xyPoint.Y));

Was mache ich da falsch? Wenn ich die Bilder einzeln suche, also ohne Thread gleicher Code, findet er sie einwandfrei.

Die Version von letzter Nacht mach auch alles richtig. Also werte werden richtig zurück gegeben.

Grüße s0n

Zitat von Blup:

Mal abgesehen von der falschen Verwendung von Threads...

Das Kopieren eines Ausschnitts der ScreenBMP in die tempBmp ist hier der eigentlich bremsende Faktor.
Es erscheint mir sinnvoller die Funktion "Compare2Bitmaps" so anzupassen, dass statt zwei kompletter Bitmaps, nur der angegebene Bereich verglichen wird.

Compare2Bitmaps(80, SearchBMP, ScreenBMP, rectSource);

ich kopiere in die TempBmp einen Ausschnitt des Screens und nur der wird mit dem Suchbitmap verglichen. Verstehe jetzt nicht so ganz wie du es meinst.
Bin für Kritik und Verbesserung jederzeit zu haben ^^

Grüße s0n