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

[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.

[Harry Stahl]

Wenn Du so weiter machst, hast Du bald so eine Art Test-Suite im Angebot...

Die Ex und SSEex erscheinen recht schnell, jedoch weichen die Messungen relativ stark voneinander ab, wenn ich einfach ein paar mal hintereinander die gleiche Funktion aufrufe (siehe anliegenden Screenshot).

Woran könnte denn so etwas liegen?

[Amateurprofi]

Zitat von Harry Stahl:

Wenn Du so weiter machst, hast Du bald so eine Art Test-Suite im Angebot...

Die Ex und SSEex erscheinen recht schnell, jedoch weichen die Messungen relativ stark voneinander ab, wenn ich einfach ein paar mal hintereinander die gleiche Funktion aufrufe (siehe anliegenden Screenshot).

Woran könnte denn so etwas liegen?

@Harry:
nee, ich werde garantiert nichts im Angebot haben.
Ich mach das alles nur aus Jux und Dallerei, aus Spaß an der Sache eben.

Das mit den Abweichungen ist bei mir nicht anders, allerdings nur bei der Release-Version.
Bei der Debug-Version sind die Abweichungen (bei mir) eher vernachlässigbar.

Eigentlich sollte man ja vermuten, dass es genau anders herum wäre.
Vielleicht liegt des Rätsels Lösung ja darin, dass bei EMBA die als Release kompilierte Version die Debug-Version ist und vice versa.
Aber ich möchte mich nicht einreihen, in die Gruppe, die an EMBA kein gutes Haar läßt.
Mein Rechner läuft im 7/24 Modus und mein Delphi auch.
Der letzte Neustart ist bestimmt schon 2 Monate her und Delphi Abstürze habe ich äußerst selten erlebt.
Ich bin damit sehr zufrieden.

Ich habe das Testprogramm gleich noch etwas erweitert, so dass man die Funktionen automatisch mehrfach ausführen kann und eine Option hinzugefügt, die bei mehrfach, mit gleichen Parametern, ausgeführten Funktionen die Min-, Max- und Avg-Werte ermittelt und dann nur noch diese anzeigt.
Der Testlauf kann mit der Escape Taste abgebrochen werden.