Speed von gleichen Threads unterschiedlich

**RaSoWa1**

Hallo,
ich da mal eine Frage.

In einem Projekt, in dem ich einige tausend Bilder verwalte, habe ich eine Prozedur mit der ich ähnliche oder gleiche Bilder suchen kann. Um diese Prozedur zu beschleunigen, teile ich die Liste der zu überprüfenden Bilder durch die Anzahl der Prozessorkerne und lagere die Überprüfung in die entsprechenden Anzahl von Threads aus.

Wenn zur Suche die Funktion "VergleicheHorizontal" (Code sieh unten) verwendet wird, geht es mit 4 Threads fast 3 x so schnell.

Wenn ich aber zur Suche die Funktion "VergleicheVertikal" verwende, dauert es mit den 4 Thread 4 x länger als in der ursprünglichen Prozedur. Wenn ich für diese Funktion nur 1 Thread starte, geht zwar etwas schneller. Aber je mehr Threads ich verwende, desto länger dauert es mit dieser Funktion.
Ich vermute, die Threads bremsen sich gegenseitig aus. Nur wo?
Wieso steigt bei der Funktion "VergleicheHorizontal" die Geschwindigkeit mit der Anzahl der Threads und bei "VergleicheVertikal" nicht? Dort ist es genau umgekehrt.
Der Code unterscheidet sich im wesentlichen doch nur in der unterschiedlichen Anzahl der Verwendung von Scanline.

Über ein paaar Tips würde ich mich sehr freuen.
Viele Grüße
Klaus

Hier der Code der beiden Funktionen:

zusammenfalten · markieren

Delphi-Quellcode:

			function VergleicheBmp(bmp0, bmp1: TBitmap; VerglMode: TBmpVerglMode; toleranz: integer; SollProz: double = 0): double;

  function VergleicheHorizontal(bmp0, bmp1: TBitmap; toleranz: Integer): double;

  var  x, y,

       r0, g0, b0,

       r1, g1, b1,

       size0,

       diff     : LongInt;

       p0, p1   : pRGBValue;

  begin

    diff  := 0;

    size0 := bmp0.Height;

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

      p0 := bmp0.Scanline[y];

      p1 := bmp1.Scanline[y];

      r0 := 0; g0 := 0; b0 := 0;

      r1 := 0; g1 := 0; b1 := 0;

      for x := 0 to bmp0.Width-1 do begin

        inc(r0, p0.Red);

        inc(g0, p0.Green);

        inc(b0, p0.Blue);

        inc(r1, p1.Red);

        inc(g1, p1.Green);

        inc(b1, p1.Blue);

        Inc(p1);

        Inc(p0);

        end;

      r0 := r0 div bmp0.Width;

      g0 := g0 div bmp0.Width;

      b0 := b0 div bmp0.Width;

      r1 := r1 div bmp1.Width;

      g1 := g1 div bmp1.Width;

      b1 := b1 div bmp1.Width;

      if  abs(r1-r0) > toleranz

      then inc(diff)

      else

        if abs(g1-g0) > toleranz

        then inc(diff)

        else

          if abs(b1-b0) > toleranz

          then inc(diff);

      end;

    result := diff*100/size0;

  end;

  function VergleicheVertikal(bmp0, bmp1: TBitmap; toleranz: Integer): double;

  var  x, y,

       r0, g0, b0,

       r1, g1, b1,

       size0,

       diff     : LongInt;

       p0, p1   : pRGBValue;

  begin

    diff  := 0;

    size0 := bmp0.Width;

    for x := 0 to bmp0.Width-1 do begin

      r0 := 0; g0 := 0; b0 := 0;

      r1 := 0; g1 := 0; b1 := 0;

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

        p0 := bmp0.Scanline[y];

        p1 := bmp1.Scanline[y];

        inc(p0, x);

        inc(p1, x);

        inc(r0, p0.Red);

        inc(g0, p0.Green);

        inc(b0, p0.Blue);

        inc(r1, p1.Red);

        inc(g1, p1.Green);

        inc(b1, p1.Blue);

        end;

      r0 := r0 div bmp0.Height;

      g0 := g0 div bmp0.Height;

      b0 := b0 div bmp0.Height;

      r1 := r1 div bmp1.Height;

      g1 := g1 div bmp1.Height;

      b1 := b1 div bmp1.Height;

      if  abs(r1-r0) > toleranz

      then inc(diff)

      else

        if abs(g1-g0) > toleranz

        then inc(diff)

        else

          if abs(b1-b0) > toleranz

          then inc(diff);

      end;

    result := diff*100/size0;

  end;

begin

  // bmp auf gleiche Größe bringen:

  if bmp0.Height*bmp0.Width <> bmp1.Height*bmp1.Width

  then NewSizeToBitmap(bmp1, bmp0.Height, bmp0.Width);

  // Pixelformat egalisieren:

  if bmp0.PixelFormat <> pf24bit

  then bmp0.PixelFormat := pf24bit;

  if bmp1.PixelFormat <> pf24bit

  then bmp1.PixelFormat := pf24bit;

//  Bereichsüberprüfung des Compilers ggf. abschalten:

{$IFOPT R+}

{$R-}

{$DEFINE RangCheck}

{$ENDIF}

//  bmp vergleichen:

  case VerglMode of

    cvLineH  : result := VergleicheHorizontal(bmp0, bmp1, toleranz);

    cvLineV  : result := VergleicheVertikal(bmp0, bmp1, toleranz);

    cvLineHV : begin

               result := VergleicheHorizontal(bmp0, bmp1, toleranz);

               if result > Sollproz

               then result := (result+VergleicheVertikal(bmp0, bmp1, toleranz))/2;

               end;

    else

      result := -1;

    end;

//  Bereichsüberprüfung des Compilers ggf. wieder einschalten:

{$IFDEF RangCheck}

{$R+}

{$UNDEF RangCheck}

{$ENDIF}

end;

Der Code des Threads:

zusammenfalten · markieren

Delphi-Quellcode:

			unit ThreadSuchImage;

interface

uses

  Classes, Graphics, Forms, FilterGrid, ExtCtrls,

  ClassAlbum;

const

  cThreadMsgMode_Find    =   1;

  cThreadMsgMode_Msg     =   2;

  cThreadMsgMode_Ende    = 512;

  cModFaktor             =  10;

type

  ThreadMsgDat  = packed record

                    Mode,

                    idx,

                    RefNr,

                    ImgNr,

                    Anz     : Integer;

                    sv      : Boolean;

                    end;

  pThreadMsgDat  = ^ThreadMsgDat;

  TThreadSuchImg = class(TThread)

  private  { Private declarations }

    FAlb     : TAlbum;

    FDat     : ThreadMsgDat;

    Fbmp0    : TBitmap;

    ImNr     : Integer;

    proz     : double;

    FMsgLst  : TList;

    procedure AddToGrd;

    procedure SetMsg;

    procedure SetEndeMsg;

  public

    constructor Create(aAlb: TAlbum; tmd: ThreadMsgDat; RefBmp: TBitmap; MsgLst: TList);

    function  VerglImg: Boolean;

  protected

    procedure Execute; override;

  end;

implementation

uses SysUtils,

     ClassImage, DlgVergImg, AlbenText, Alben, AlbenConst, ClassEinst,

     ToolGrafik;

constructor TThreadSuchImg.Create(aAlb: TAlbum; tmd: ThreadMsgDat; RefBmp: TBitmap; MsgLst: TList);

begin

  inherited Create(True);

  FAlb              := aAlb;    

  FDat              := tmd;

  Fbmp0             := RefBmp;

  FMsgLst           := MsgLst;

  Priority          := tpHighest;

  FreeOnTerminate   := True;

end;

procedure TThreadSuchImg.AddToGrd;

var  ptmd     : pThreadMsgDat;

begin

  new(ptmd);

  ptmd^.Mode  := cThreadMsgMode_Find;

  ptmd^.idx   := FDat.idx;

  ptmd^.RefNr := FDat.RefNr;

  ptmd^.ImgNr := ImNr;

  ptmd^.Anz   := round(Proz*100);

  FMsgLst.Add(ptmd);

end;

procedure TThreadSuchImg.SetMsg;

var  ptmd     : pThreadMsgDat;

begin

  new(ptmd);

  ptmd^.Mode  := cThreadMsgMode_Msg;

  ptmd^.idx   := FDat.idx;

  ptmd^.ImgNr := ImNr;

  FMsgLst.Add(ptmd);

end;

procedure TThreadSuchImg.SetEndeMsg;

var  pTmd     : pThreadMsgDat;

begin

  new(pTmd);

  pTmd^.Mode  := cThreadMsgMode_Ende;

  pTmd^.idx   := FDat.idx;

  FMsgLst.Add(pTmd);

end;

function TThreadSuchImg.VerglImg: Boolean;

var  i,

     toleranz : Integer;

     bmp1     : TBitmap;

     sv1      : boolean;

     SollProz : double;

     VerglDat : TVerglImgDatRec;    // ist ein record in dem die Sucheinstellungen gespeichert werden

     lst      : TStringList;

  function GetBmpFilename(ai: TAlbImg): string;

  begin

    if FAlb.VerglImg.DiaMode

    then result := FAlb.FileNameDia[ai]

    else result := FAlb.FileNameImg[ai];

  end;

begin

  toleranz := round(255*FAlb.VerglImg.Toleranz/100);

  SollProz := 100-FAlb.VerglImg.Proz;

  VerglDat := FAlb.VerglImg.VerglImgDat;

  lst      := TStringlist.Create;

  try

    for i := FDat.ImgNr to FDat.ImgNr+FDat.Anz-1 do

      if i <> FDat.RefNr

      then lst.Add(GetBmpFilename(FAlb.ImgLst[i]));

    for i := 0 to lst.Count-1 do begin

      if Terminated

      then Break;

      bmp1 := TBitmap.Create;

      try

        LoadGrafikToBmp(bmp1, lst[i]);

        sv1 := bmp1.Height > bmp1.Width;

        if not(VerglDat.Sv) or (FDat.sv = sv1)

        then proz := VergleicheBmp(FBmp0, bmp1, VerglDat.VerglMode, toleranz, VerglDat.Proz)

        else proz := SollProz+1;

      finally

        bmp1.Free;

        end;

      ImNr := FDat.ImgNr+i;

      if proz <= SollProz

      then AddToGrd;

      if i mod cModFaktor = 0

      then SetMsg;

      end;

  finally

    lst.Free;

    end;

end;

procedure TThreadSuchImg.Execute;

begin

  try

    VerglImg;

  finally

    SetEndeMsg;

    end;

end;

end.

Speed von gleichen Threads unterschiedlich

Speed von gleichen Threads unterschiedlich

Forumregeln