Hallo,
Ich habe an dem Problem jetzt etliche Stunden getestet und probiert, bin aber nicht viel weiter gekommen.
Ich hatte den Vorschlag von Dunkel in der Methode VergVertikalNew (Code siehe unten) umgesetzt. Lief Anfangs so wie gewollt. Als ich die Datenmenge erhöhte, wurden immer weniger Bilder gefunden. Als ich das Häckchen in der Debuggeroption "Stop on Delphi Exceptions" gesetzt hatte, kam ich der Ursache auf die Spur. Die Threads wurden nach 2 bis ca 50 Schleifendurchläufen mit der Fehlermeldung "Project Fotoalbum3.exe raised
exception class EOutOfResources with message 'Das
Handle ist ungültig.'" in der Prozedur GDIError (
Unit Graphics) abgebrochen. Was wird da nicht richtig freigegenen?
Statt RotateBitmap habe ich nun meine bisherige Prozedur (Code siehe auch unten) zum Drehen verwendet. Es geht zwar langsamer als mit RotateBitmap, aber es funktioniert. Auch sind 4 Threads schneller als nur 1 Thread.
Es kann also nicht an Scanline liegen. Diese Methode wird ja jetzt wesentlich mehr verwendet als vorher.
Aber was kann nun die Ursache sein das die alte Methode VergleicheVertikal nicht funktioniert?
Delphi-Quellcode:
function VerglVertikalNew(bmp0, bmp1: TBitmap; toleranz, SollProz: Integer): double;
var TempBmp : TBitmap;
begin
TempBmp := TBitmap.Create;
try
TempBmp.Assign(bmp0);
// RotateBitmap(TempBmp);
// RotateBitmap(bmp1);
DreheBmpNachRechts(TempBmp,1);
DreheBmpNachRechts(bmp1, 1);
result := VergleicheHorizontal(TempBmp, bmp1, toleranz, SollProz);
finally
TempBmp.Free;
end;
end;
Delphi-Quellcode:
procedure DreheBmpNachRechts(bmp: TBitmap; Anz: integer);
type TMyHelp = array[0..0] of TRGBQuad;
var RowOut : ^TMyHelp;
P : pRGBQuad; //^THelpRGB;
x, y, b, h : integer;
help : TBitmap;
OldPixForm : TPixelFormat;
i : integer;
begin
OldPixForm := bmp.PixelFormat;
bmp.PixelFormat := pf32bit;
help := TBitmap.Create;
// Bereichsüberprüfung des Compilers für RowOut[x] ggf. abschalten:
{$IFOPT R+}
{$R-}
{$DEFINE RangCheck}
{$ENDIF}
try
help.PixelFormat := pf32bit;
for i := 1 to Anz do begin
b := bmp.Height;
h := bmp.Width;
help.Width := b;
help.height := h;
for y := 0 to (h-1) do begin
RowOut := help.ScanLine[y];
P := bmp.scanline[bmp.height-1];
inc(p,y);
for x := 0 to (b-1) do begin
RowOut[x] := p^;
inc(p,h);
end;
end;
bmp.Assign(help);
end;
bmp.PixelFormat := OldPixForm;
finally
help.Free;
// Bereichsüberprüfung des Compilers ggf. wieder einschalten:
{$IFDEF RangCheck}
{$R+}
{$UNDEF RangCheck}
{$ENDIF}
end;
end;
Hat jemand eine Idee?
Grüße
Klaus