Einzelnen Beitrag anzeigen

RaSoWa1

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

Re: Speed von gleichen Threads unterschiedlich

  Alt 18. Jan 2009, 12:06
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
Klaus
  Mit Zitat antworten Zitat