Thread läuft nicht parallel --

[sonny2007]

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

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

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