Delphi-PRAXiS
Seite 5 von 7   « Erste     345 67      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Delphi Prüfung eines Bitmaps auf Transparenz (gehts noch schneller)? (https://www.delphipraxis.net/188328-pruefung-eines-bitmaps-auf-transparenz-gehts-noch-schneller.html)

Neutral General 24. Feb 2016 08:40

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

Zitat von Amateurprofi (Beitrag 1331161)
m.E. kann die Funktion nur sehr eingeschränkt funktionieren.

1) Überprüfter Bereich der Bitmap:

Das ist mir im Nachhinein auch noch aufgefallen, stimmt.

Zitat:

Zitat von Amateurprofi (Beitrag 1331161)
2) Prüfung von jeweils 4 Pixeln auf Transparenz:

Nachdem ich gerade CMPEQPS nochmal nachgeschlagen habe, muss ich sagen: Auch da hast du Recht.
Ich hatte es so gelesen, dass es entweder nur ein true für "alles ist gleich" oder ein false "irgendwas ist anders" gibt.

Okay dann ist meine SSE-Variante wohl Schrott :mrgreen:
Ein Versuch wars Wert :stupid:

Memnarch 24. Feb 2016 09:37

AW: Prüfung eines Bitmaps auf Transparenz (gehts noch schneller)?
 
Was für ne CPU hast du? AUf meinem i5 @3GHZ

Hat die Ursprungsmethode(XE):

Debug: 30ms
Release: 8ms

Und so:
Delphi-Quellcode:
type
  TRGBA = packed record
    B, G, R, A: Byte;
  end;

  PRGBA = ^TRGBA;

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

function HasTransparentRGBAValues (const bm:TBitmap): Boolean;
var
  x, z: Integer; RGBA: PScanLine;
  LPixel: PRGBA;
begin
  Result := FALSE;
  RGBA := bm.Scanline[bm.Height-1];
  z := bm.Width * bm.Height;
  LPixel := @RGBA[0];
  for x := 0 to z-1 do begin
    if LPixel.A < 255 then
      EXIT (TRUE);
    Inc(LPixel, SizeOf(TRGBA));
  end;
end;
Debug: 7ms
Release: 3ms

Seh da keinen bedarf für Hexenwerk optimierungen

Neutral General 24. Feb 2016 09:46

AW: Prüfung eines Bitmaps auf Transparenz (gehts noch schneller)?
 
@Memnarch: Deine Methode überspringt auch 3/4 der Pixel :mrgreen:
Delphi-Quellcode:
Inc(LPixel, SizeOf(TRGBA));

Bei inc wird ein typisierter Pointer immer um die Größe des Typs inkrementiert. (Auch ohne Angabe des 2. Parameters)
D.h. mit deinem Code springst du nicht SizeOf(TRGBA) Bytes weiter, sondern SizeOf(TRGBA)*SizeOf(TRGBA) Bytes

Uwe Raabe 24. Feb 2016 09:46

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

Zitat von Memnarch (Beitrag 1331182)
Debug: 7ms
Release: 3ms

Delphi-Quellcode:
  LPixel: PRGBA;
...
Inc(LPixel, SizeOf(TRGBA));
Das
Delphi-Quellcode:
Inc
verschiebt den Pointer nun (auf einem 32-Bit System) um 16 Byte weiter. Gemäß der Hilfe:

Zitat:

Wenn X ein Zeigertyp ist, wird X um N-mal der Größe des Typs, auf den gezeigt wird, inkrementiert.
Delphi-Quellcode:
Inc(LPixel);
ist vollkommen ausreichend um das nächste Pixel zu adressieren.

Memnarch 24. Feb 2016 10:04

AW: Prüfung eines Bitmaps auf Transparenz (gehts noch schneller)?
 
Ach ich vertu mich auch immerwieder :D
Dann sinds auch hier im Release 8ms

Trotzdem, 8ms sind hier noch flott genug. Mich interessiert erstmal die CPU des Threaderstellers o.O

EDIT:
Folgendes braucht im Release 5(-6)ms:
Delphi-Quellcode:
function HasTransparentRGBAValues (const bm:TBitmap): Boolean;
var
  z: Integer; RGBA: PScanLine;
  LPixel, LLastPixel: PRGBA;
begin
  RGBA := bm.Scanline[bm.Height-1];
  z := bm.Width * bm.Height;
  LPixel := @RGBA[0];
  LLastPixel := @RGBA[z - 1];
  while (LPixel.A = 255) and (LPixel <> LLastPixel) do
    Inc(LPixel);
  Result := LPixel.A < 255;
end;

Harry Stahl 24. Feb 2016 17:15

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

Zitat von Memnarch (Beitrag 1331186)
Ach ich vertu mich auch immerwieder :D
Dann sinds auch hier im Release 8ms

Trotzdem, 8ms sind hier noch flott genug. Mich interessiert erstmal die CPU des Threaderstellers o.O

EDIT:
Folgendes braucht im Release 5(-6)ms:
Delphi-Quellcode:
function HasTransparentRGBAValues (const bm:TBitmap): Boolean;
var
  z: Integer; RGBA: PScanLine;
  LPixel, LLastPixel: PRGBA;
begin
  RGBA := bm.Scanline[bm.Height-1];
  z := bm.Width * bm.Height;
  LPixel := @RGBA[0];
  LLastPixel := @RGBA[z - 1];
  while (LPixel.A = 255) and (LPixel <> LLastPixel) do
    Inc(LPixel);
  Result := LPixel.A < 255;
end;

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

AMD Athlon 64 X2 Dual Core Processor 5000+, 2600 MHz, 2 Kern(e), 2 logische(r) Prozessor(en)

Die hier gezeigte Variante ist mit ca. 23 MS in etwa so schnell wie meine Lösung (ebenfalls im Release-Mode)

Harry Stahl 24. Feb 2016 17:34

AW: Prüfung eines Bitmaps auf Transparenz (gehts noch schneller)?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Zitat:

Zitat von Amateurprofi (Beitrag 1331162)
Hallo Harry:
Ich hab mir mal die Mühe gemacht, mehrere ASM-Routinen zu schreiben, die alle recht flink arbeiten, und zusätzlich ein kleines Testprogramm.

Wow, bin beeindruckt:thumb:

In der Anlage ein Screenshot mit den Testergebnissen. Meine AMD-CPU ist halt doch ein Ticken langsamer.

Was mich aber wundert, sind die z.T. erheblichen Schwankungen beim gleichen Test (SSE: 13 / 25 MS).

32- oder 64-Bit macht keinen nennenswerten Unterschied.

Valle 24. Feb 2016 18:00

AW: Prüfung eines Bitmaps auf Transparenz (gehts noch schneller)?
 
Eine andere Möglichkeit wäre es, mehrere Threads zur Bearbeitung bereits vorher zu starten und erst bei Bedarf zu aktivieren.

Das sollte den Overhead reduzieren und die Ausführungsgeschwindigkeit durch Parallelisierung dennoch erhöhen. Es wäre nur ein Minimum an Synchronisation nötig. Soweit ich das sehe, würde es reichen das Bild in n halbwegs gleichgroße Abschnitte zu unterteilen und dann auf die n Threads loszulassen. Der Hauptthread könnte darauf warten, bis alle Threads fertig sind.

Vermutlich wäre das noch schneller als die Single-Core Lösungen. Allerdings auch etwas aufwendiger zu implementieren.

Harry Stahl 24. Feb 2016 18:37

AW: Prüfung eines Bitmaps auf Transparenz (gehts noch schneller)?
 
Also die Single-Core-Lösung die hier am schnellsten ist, ist die aus "IsPartlyTransparentASM" (unter AQTime wird die in Average-Time ca. 20 MS schneller angezeigt, als meine Standard-Variante. Im Einzeltest sind die aber fast gleichschnell. Keine Ahnung, warum hier so Unterschiede entstehen. Bei AQTime gab es allerdings ca. 26 Durchläufe).

Die Variante habe ich hier mal auf meine Aufrufkonvention umgestaltet, um nicht doppelte Funktionsaufrufe zu haben.

Frage an die ASM-Experten: Kann man das noch etwas schöner machen?
Delphi-Quellcode:
function HasTransparentRGBAValues (const bm:TBitmap): Boolean;
var
  W,H:NativeInt; P0,P1:Pointer;
begin
  P0 := bm.ScanLine[0]; p1 := bm.ScanLine[1];
  w := bm.Width; h:= bm.Height;

  asm
  // EAX=P0, Zeigt auf Zeile 0 der Bitmap
  // EDX=P1, Zeigt auf Zeile 1 der Bitmap
  // ECX=W, Breite der Bitmap
  // Stack=H, Höhe der Bitmap

                 mov EAX,P0 // von mir ergänzt
                 mov EDX,P1 //
                 mov ECX,w //

                 sub     edx,eax             // Offset von Zeile 1 zu Zeile 0
                 js      @BottomUp
                 imul    edx,H               // Bytes/Zeile*Zeilen
                 add     eax,edx             // Auf unterste Zeile
  @BottomUp:    lea     eax,[eax+ecx*4+3]   // Hinter letztes Pixel (auf A-Byte)
                 imul    ecx,H               // Anzahl Pixel
                 neg     ecx
  @Loop:        cmp     byte[eax+ecx*4],$FF
                 jne     @True
                 add     ecx,1
                 jl      @Loop
                 xor     al,al
                 jmp     @End
  @True:        mov     al,True
  @End:
  end;
end;
Edit: Hmmmh... irgendwas scheint an der procedure aber noch nicht zu stimmen, denn an einer Stelle des Programmablaufs stimmt plötzlich etwas nicht mehr (beim ersten Ausblenden der Hintergrundebene wird das Schachmuster plötzlich nicht mehr angezeigt, sondern eine weiße Arbeitsfläche, also irgendwo liefert die Funktion anscheinend einmal ein falsches Ergebnis zurück)

Amateurprofi 25. Feb 2016 02:48

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

Zitat von Harry Stahl (Beitrag 1331261)
Also die Single-Core-Lösung die hier am schnellsten ist, ist die aus "IsPartlyTransparentASM" (unter AQTime wird die in Average-Time ca. 20 MS schneller angezeigt, als meine Standard-Variante. Im Einzeltest sind die aber fast gleichschnell. Keine Ahnung, warum hier so Unterschiede entstehen. Bei AQTime gab es allerdings ca. 26 Durchläufe).

Die Variante habe ich hier mal auf meine Aufrufkonvention umgestaltet, um nicht doppelte Funktionsaufrufe zu haben.

Frage an die ASM-Experten: Kann man das noch etwas schöner machen?
Delphi-Quellcode:
function HasTransparentRGBAValues (const bm:TBitmap): Boolean;
var
  W,H:NativeInt; P0,P1:Pointer;
begin
  P0 := bm.ScanLine[0]; p1 := bm.ScanLine[1];
  w := bm.Width; h:= bm.Height;

  asm
  // EAX=P0, Zeigt auf Zeile 0 der Bitmap
  // EDX=P1, Zeigt auf Zeile 1 der Bitmap
  // ECX=W, Breite der Bitmap
  // Stack=H, Höhe der Bitmap

                 mov EAX,P0 // von mir ergänzt
                 mov EDX,P1 //
                 mov ECX,w //

                 sub     edx,eax             // Offset von Zeile 1 zu Zeile 0
                 js      @BottomUp
                 imul    edx,H               // Bytes/Zeile*Zeilen
                 add     eax,edx             // Auf unterste Zeile
  @BottomUp:    lea     eax,[eax+ecx*4+3]   // Hinter letztes Pixel (auf A-Byte)
                 imul    ecx,H               // Anzahl Pixel
                 neg     ecx
  @Loop:        cmp     byte[eax+ecx*4],$FF
                 jne     @True
                 add     ecx,1
                 jl      @Loop
                 xor     al,al
                 jmp     @End
  @True:        mov     al,True
  @End:
  end;
end;
Edit: Hmmmh... irgendwas scheint an der procedure aber noch nicht zu stimmen, denn an einer Stelle des Programmablaufs stimmt plötzlich etwas nicht mehr (beim ersten Ausblenden der Hintergrundebene wird das Schachmuster plötzlich nicht mehr angezeigt, sondern eine weiße Arbeitsfläche, also irgendwo liefert die Funktion anscheinend einmal ein falsches Ergebnis zurück)

Hallo Harry,

das kann so auch nicht funktionieren.
Das Boolean-Resultat einer Funktion wird im Register AL erwartet, also dem unteren Byte von EAX.
Der Asm-Teil stellt deshalb das Resultat in AL.

Bei einer Pascal-Funktion (nicht Pure-Asm) wird eine lokale Variable "Result" angelegt, deren Inhalt vor dem Verlassen der Funktion, i.d.R. vor der Bereinigung des Stacks nach AL kopiert wird.
Was vorher in AL stand, geht dabei verloren.

Ich hab das mal im Debugger angeschaut (siehe weiter unten):
In der Kopie ist leider nicht zu sehen, an welcher Stelle der Haltepunkt ist.
Dehalb :
Der Haltepunkt steht an der Adresse 0052D36D und dort wird das Ergebnis der Prüfung, (hier True) in AL gestellt.
Versuch mal folgendes:
Beim Label True:
Das mov al,True ersetzen durch mov Result,True
Und zwei Zeilen darüber
das xor al,al ersetzen durch mov Result,False
Weiß nicht ob das dann funktioniert.
Meine Enpfehlung ist, ASM und Pascal strikt zu trennen. Der "Doppelte Funktionsaufruf", den du vermeiden möchtest,
kostet nichts (oder so gut wie nichts), er bringt dir aber sauberen Code.

Hier eine Kopie des problematischen Teils:

Transparent_Main.pas.1294: jmp @End
0052D36B EB02 jmp $0052d36f
Transparent_Main.pas.1295: @True: mov al,True
0052D36D B001 mov al,$01 // Hier wird das Ergebis des ASM-Teils definiert
Transparent_Main.pas.1298: end;
0052D36F 8BC3 mov eax,ebx // Und hier gleich danach vom Pascal-Teil überschrieben.
0052D371 5E pop esi
0052D372 5B pop ebx
0052D373 8BE5 mov esp,ebp
0052D375 5D pop ebp
0052D376 C3 ret


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:44 Uhr.
Seite 5 von 7   « Erste     345 67      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz