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

[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

[Harry Stahl]

Zitat von Sir Rufo:

Gemütlicher geht das mit TStopWatch

Klar, das kannte ich auch schon, denn wenn man unter FMX was messen will (insbesondere andere OS), dann ist es da die angesagte Funktion.

Unter Windows benutzt TStopwatch aber auch QueryPerformanceCounter und hier hatte ich mir schon vor langer Zeit mal die benötigten MS-Funktionen in eigene Start- und Stop-Funktionen gekapselt.

Aber wer das noch nicht gemacht hat, kann hier Dank der neueren Delphi-Versionen direkt bequem per Einbindung der Systems.Diagnostics drauf zugreifen.

[Amateurprofi]

Zu #54 von Memnarch:
Ich hätte da noch eine super superschnelle Funktion anzubieten, sehr kurz, unkompliziert und übersichtlich:

Delphi-Quellcode:

function HasTransparentRGBAValues(const bm:TBitmap): Boolean;
begin
   Result:=True;
end;

@Memnarch:
Ist natürlich nicht ernst gemeint, deshalb bitte nicht böse sein.
Aber genau das liefert Deine in #54 gepostete Funktion.
Ich habe mal versucht, zu verstehen was Deine Funktion genau macht und habe eine kommentierte Version erstellt.
Hoffentlich hab ich mich da nicht vertan.

Delphi-Quellcode:

function HasTransparentRGBAValues(bmp:TBitmap): Boolean;
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;
var
   z: Integer;
   RGBA: PScanLine;
   LPixels, LLastPixels: PRGBA4;
   LPixel: PRGBA;
   i: Integer;
begin
   RGBA := bmp.Scanline[bmp.Height-1]; // Zeigt auf erstes Pixel der Bitmap
   z := bmp.Width * bmp.Height; // Anzahl Pixel
   LPixels := @RGBA[0]; // Adresse des ersten Pixels
   LLastPixels := @RGBA[z div 4 * 4]; // Zeigt hinter das letzte durch 4 teilbare Pixel
   while (LPixels <> LLastPixels) and ((LPixels[0].A and LPixels[1].A and LPixels[2].A and LPixels[3].A) = 255) do
     Inc(LPixels);
   // LPixels zeigt jetzt
   //  1) entweder auf das erste von 4 Pixeln, von denen mindestens eins transparent ist.
   //  2) oder, wenn Z nicht durch 4 teilbar ist, hinter das letzte durch 4 teilbare Pixel.
   //  3) oder, wenn Z durch 4 teilbar ist, hinter das letzte Pixel der Bitmap.
   Result := ((LPixels[0].A and LPixels[1].A and LPixels[2].A and LPixels[3].A) <> 255);
   // Die obige Ermittlung des Resultats ist für die Fälle 2 und 3 fehlerhaft
   // weil hier auf Speicherbereiche zugegriffen wird, die nicht mehr zur
   // Bitmap gehören.
   // Im Fall (2), weil ab LPixels maximal 3 Pixel folgen
   // Im Fall (3), weil LPixels bereits außerhalb der Bitmap liegt
   // Wenn in diesem Bereich mit undefiniertem Inhalt NICHT zufällig das 4te und
   // 8te und 12te und 16te Byte = 255 sind (was in der Regel nicht vorkommt),
   // wird als ergebnis TRUE geliefert.
   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;

[Memnarch]

Bin nicht böse, hatte ja erwähnt ich könnte nen off by one haben

[Amateurprofi]

Ich habe einmal die hier geposteten Funktionen in mein Testprogramm kopiert und alle Funktionen mit gleichen Parametern (4244x2819 Pixel, alle Pixel intransparent) laufen lassen.
Die Ergebnisse seht ihr in anhängenden Screenshots.
Das Testprogramm selbst habe ich noch ein wenig aufgehübscht und ebenfalls incl. SourceCodes angehängt.
Die in der .zip enthaltene Exe ist die 32Bit-Release Version.

@Harry:
Für Dich sollte die "IsPartlyTransParentEx" interessant sein, sowohl als 32Bit wie auch als 64Bit-Version.

Interessant ist vielleicht auch die Möglichkeit Screenshots zu machen und entweder als Bitmap ins Clipboard zu stellen oder als .bmp oder .jpg zu speichern.
Screenshots werden mit P, B oder J plus Shift, Ctrl, Alt erzeugt.
P stellt das Bild ins Clipboard, B speichert es als Bitmap und J speichert es als Jpeg.
Die Kombination der Shift, Ctrl, Alt Tasten bestimmt, was kopiert wird. Was die verschiedenen Tasten-Kombinationen machen, ist am Anfang der Main-Form beschrieben.