Einzelnen Beitrag anzeigen

RaSoWa1

Registriert seit: 1. Jun 2006
Ort: Halle/Saale
140 Beiträge
 
Delphi 2010 Professional
 
#1

Speed von gleichen Threads unterschiedlich

  Alt 11. Jan 2009, 10:25
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:
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:
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.
Klaus
  Mit Zitat antworten Zitat