Prüfung eines Bitmaps auf Transparenz (gehts noch schneller)?

[Harry Stahl]

Derzeit verwende ich folgende Methode, um ein 32-bit-Bitmap auf Vorhandensein eines (Teil-) Transparenten Pixels zu prüfen:

Delphi-Quellcode:

function HasTransparentRGBAValues (const bm:TBitmap): Boolean;
var
  x, z: Integer; RGBA: pRGBALine;
begin
  Result := FALSE;
  RGBA := bm.Scanline[bm.Height-1];
  z := bm.Width * bm.Height;

  for x := 0 to z-1 do begin
    if RGBA^[x].rgbReserved <> 255 then begin
      EXIT (TRUE);
    end;
  end;
end;

Bei einem Nicht transparentem Bild in den Ausmaßen 4244x2819 Pixel benötigt die Routine hier auf meinem Rechner ca. 80 MS um das ganze Bitmap zu prüfen, was ziemlich viel Zeit ist.

Kennt jemand da evtl. eine noch schnellere Methode als die oben dargestellte?

[Delphi-Laie]

Zitat von Harry Stahl:

Delphi-Quellcode:

function HasTransparentRGBAValues (const bm:TBitmap): Boolean;
var
  x, z: Integer; RGBA: pRGBALine;
begin
  Result := FALSE;
  RGBA := bm.Scanline[bm.Height-1];
  z := bm.Width * bm.Height;

  for x := 0 to z-1 do begin
    if RGBA^[x].rgbReserved <> 255 then begin
      EXIT (TRUE);
    end;
  end;
end;

Warum hat die Funktion nie die Möglichkeit, true zurückzuliefern?

Edit: OK, das wird wohl im Exitparameter realisiert - diese Möglichkeit war mir neu.

[Der schöne Günther]

Parallelisieren?

[Harry Stahl]

Zitat von Der schöne Günther:

Parallelisieren?

Bin mir da nicht so sicher, wegen des Overheads. Hatte ich zwar schon mal gemacht, allerdings zeigt mir AQtime seltsame Messwerte an (0,3 MS, was nicht sein kann) und bei einem Extra-Test-Projekt schwanken die einzelnen Testergebnisse zwischen 28 und 56 MS:

Delphi-Quellcode:

type
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;

  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32;
  PRGB32Array = ^TRGB32Array;

function HasTransparentRGBAValuesx (const bm:TBitmap): Boolean;
var
  LineLen: Integer; found: boolean;
  FirstLine : PRGB32Array;
begin
  Found := false;
  if bm.Width = 0 then exit;

  FirstLine := bm.ScanLine[0];
  LineLen := - bm.width;

  TParallel.For (0, bm.Height-1, procedure (y:Integer; S: TParallel.TLoopState)
  var
    x, p: Integer;
  begin
    if not s.ShouldExit then begin
      P := y*LineLen;
      for x := 0 to bm.Width-1 do begin
        if FirstLine[P+x].A <> 255 then begin
          found := true;
          s.Break;
          break;
        end;
      end;
    end;
  end);

  Result := found;
end;

Insofern wäre mir hier eine Variante ohne Parallelisierung mit eindeutig besseren Ergebnissen lieber

[Luckie]

Bitmap komplett in den Speicher laden, damit man keine Festplattenzugriffe hat und dann mit zwei Threads von vorne und hinten prüfen?

[jaenicke]

Ich hätte schon Ideen, aber dafür wäre ein Beispielbild sehr gut. Ohne Photoshop kenne ich auf Anhieb kein Tool, mit dem ich einer Bitmap einen Alphakanal hinzufügen könnte.

[Uwe Raabe]

Zitat von Harry Stahl:

Meine CPU ist schon etwas älter, aber durchaus schnell genug für meine Zwecke:

Zitat von Harry Stahl:

...benötigt die Routine hier auf meinem Rechner ca. 80 MS um das ganze Bitmap zu prüfen, was ziemlich viel Zeit ist.

[Memnarch]

Ach sach ma:
Wie misst du eigentlich die Zeit? Doch hoffentlich nicht mit Now()

Nochmal genauer gemessen:
Meine alte Variante brauchte ~ 5.8ms
Nen bisschen was umgestellt und jetzt läuft sie bei mir zwischen 3.9 - 4.1ms
(Vielleicht ist nen off by one error drin nicht genau geprüft *hust*)

Delphi-Quellcode:

type
  TRGBA = packed record
    B, G, R, A: Byte;
  end;

  PRGBA = ^TRGBA;

  TRGBA4 = array[0..3] of TRGBA;
  PRGBA4 = ^TRGBA4;

  TScanLine = array[0..100000] of TRGBA;
  PScanLine = ^TScanLine;

function HasTransparentRGBAValues(const bm:TBitmap): Boolean;
var
  z: Integer;
  RGBA: PScanLine;
  LPixels, LLastPixels: PRGBA4;
  LPixel: PRGBA;
  i: Integer;
begin
  RGBA := bm.Scanline[bm.Height-1];
  z := bm.Width * bm.Height;
  LPixels := @RGBA[0];
  LLastPixels := @RGBA[z div 4 * 4];
  while (LPixels <> LLastPixels) and ((LPixels[0].A and LPixels[1].A and LPixels[2].A and LPixels[3].A) = 255) do
    Inc(LPixels);
  Result := ((LPixels[0].A and LPixels[1].A and LPixels[2].A and LPixels[3].A) <> 255);
  if not Result then
  begin
    Inc(LPixels);
    LPixel := PRGBA(LPixels);
    for i := 0 to z mod 4 - 1 do
    begin
      if LPixel.A < 255 then
        Exit(True);
      Inc(LPixel);
    end;
  end;
end;

[Harry Stahl]

Zitat von Memnarch:

Ach sach ma:
Wie misst du eigentlich die Zeit? Doch hoffentlich nicht mit Now()

Nochmal genauer gemessen:

Messe mit

QueryPerformanceFrequency(iTimerFreq);
QueryPerformanceCounter(iTimerStart);

Das sollte doch OK sein, oder?

[Sir Rufo]

Gemütlicher geht das mit TStopWatch