Registriert seit: 1. Jun 2006
Ort: Halle/Saale
140 Beiträge
Delphi 2010 Professional
|
Speed von gleichen Threads unterschiedlich
11. Jan 2009, 11: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
|