Splash Screen transparant?

[MmVisual]

Nein der Baum sieht gut aus.

Ich weiß dass ein Bild im Speicher von der X Zeile her manchmal mehr Bytes belegt als wie es breit ist. Es liegt daran dass bei manchen Teilern der Compiler besser drauf zugreifen kann. Wenn man jedoch von einem Linearen Adressbereich ausgeht, dann erhält man um diese zu viele Bytes in X einen Versatz. Und genau den sieht man in meinem Bild, da die X Auflößung nicht zufällig gerade passt.
(Deshalb sollte man auch nicht direkt auf dem Bild-Speicher rum machen, denn der wird je nach Pixelformat und irgend welchen anderen Optionen anders aufgeteilt)

Die einzige Funktion die ich in Lazarus gefunden habe und (halb) funktioniert:
- TBitmap neu anlegen
- größe einstellen
- Monchrom einstellen
- Bitmap.Canvas.BrushCopy(rect(ganzes Bild), BitmapVomSplash, rect(ganzes Bild), clBlack)
Nur dass dabei die Farben negiert sind und es wird der Bildrahmen zu sehen sein und nicht das innere (deshalb "halb")

[Mathias]

Nochmals zu meinem Beispiel zurück, Widht von TImage muss zwingend durch 8 Teilbar sein. Mein TImages mit dem Baum war dies zufällig.
Die Grösse der Png scheint egal zu sein.

[Mathias]

Jetzt sollte es universell funktionieren, auch die Width des Forms hatte einen Einfluss.

[MmVisual]

Bein Win7 sieht es nicht gut aus, dafür jetzt beim Raspi:

Splash_V3_Win7.png (72.61 KiB) 2693 mal betrachtet

Splash_V3_Raspi.png (68.08 KiB) 2693 mal betrachtet

Vom Bitmap kann man doch die "ScanLine" abfragen, dann hat man immer die Adresse vom ersten Pixel der Zeile, vielleicht geht es damit besser.

Eigentlich wäre es am Besten wenn das Formular selbst eine Funktion hätte:
CreateMaskedImage(SplashBitmal: TBitmap; TransparentColor: TColor);
Damit könnte man deklarieren welche Farbe im Bild als Transparent gilt, damit könnte man eine Farbe die man sonst nicht hat verwenden (in meinem Fall z.B. Violett)

[Mathias]

Hast du den Post weiter oben, mit dem Unterschied Linux / Win beachtet ?

[MmVisual]

Welchen Post meinst Du? Ich habe nur das ZIP von 23:34 geladen und ohne Änderungen übersetzt.

[Mathias]

Welchen Post meinst Du? Ich habe nur das ZIP von 23:34 geladen und ohne Änderungen übersetzt.

Anscheinend gingen diese Zeilen gestern verloren:

Code: Alles auswählen

  if ABitmap.RawImage.Description.BitOrder = riboBitsInOrder then begin
      p^ := p^ or (1 shl bit);
    end else begin
      p^ := p^ or ((1 shl 7) shr bit);
    end;

Das passiert, wen man mit mehreren Computern rumbastelt.

Im Anhang der korrigierte Code.

[MmVisual]

Die eine Zeile hattest du doppelt geschrieben, daher hatte es unter Windows so komisch ausgesehen:

Code: Alles auswählen

p^ := p^ or (1 shl bit);

Ich habe den Code noch etwas optimiert, damit sollte es nun keine Probleme mehr geben, das Image.With setzen hab ich nun auch weg gelassen:

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
var
  bmp: TBitmap;
  x, y: integer;
 
  function GetPixel32(x, y: UInt32): boolean;
  var p: PUint32;
  begin
    p := PUint32(imgSplash.Picture.Bitmap.RawImage.GetLineStart(Y)) + x;
    Result := (p^ and $FF000000) = $FF000000;
  end;
 
  procedure SetPixel1(x, y: UInt32);
  var p: PByte;
  begin
    p := bmp.RawImage.GetLineStart(Y) + (x div 8);
    if bmp.RawImage.Description.BitOrder = riboBitsInOrder then begin
       p^ := p^ or (1 shl (x mod 8));
    end else begin
       p^ := p^ or ($80 shr (x mod 8));
    end;
  end;
 
begin
  if imgSplash.Picture.Bitmap.PixelFormat <> pf32bit then begin
    Exit;
  end;
  BorderStyle := bsNone;
  Self.Handle; // Aktiviere Handle für Form
 
  bmp := TBitmap.Create;
  bmp.Monochrome := True;
  bmp.Width := Width;
  bmp.Height := Height;
 
  with imgSplash.Picture.Bitmap do begin
    for x := 0 to Width - 1 do begin
      for y := 0 to Height - 1 do begin
        if GetPixel32(x, y) then begin
          SetPixel1(x, y);
        end;
      end;
    end;
  end;
 
  SetShape(bmp);
  bmp.FreeImage;
end; 

[MmVisual]

Unter Windows braucht die Routine 11ms, unter RaspberryPi 55ms. Das kann sich sehen lassen

Hier das Projekt, Incl Zeitmessung:

Fenster_als_Bitmap_5.zip

(187.38 KiB) 94-mal heruntergeladen

Edit: Die Übergabe von X und Y in die Routinen GetPixel/SetPixel kann man sich sparen, da X/Y ohnehin in der Funktion bekannt sind.

[Mathias]

Unter Windows braucht die Routine 11ms, unter RaspberryPi 55ms. Das kann sich sehen lassen

Viel zu langsam.

Wen ich deine Optimatzion mit GetLineStart(y) nehme (mometan augeklammert) , habe ich auf meinem I7 etwa 6ms.
Nehme ich aber das neue CopyLine, habe ich 0ms.

Jetzt müsste man das nur noch auf dem Raspi testen.

PS: Habe es grade auf meinem Raspi2 getestet alt 82ms neu 4ms, 20-fache Steigerung.

Wen man bedenkt, wie gemütlich es mit Pixels[...] war, dies ging nach deinem Beschreib 7'000ms.
Schlussendlich eine Beschleunigung von fast 2'000 !
Da sieht man wieder, was man aus einer Kiste rausholen kann, wenn optimiert.

[MmVisual]

Wow wieder schneller

Der RasperrbyPi macht das jetzt in 3ms. Nach meiner Änderung sogar noch ein klein wenig schneller.
Ich habe noch das SHR/SHL ein wenig optimiert. Nur die ASM/Intel Direktive geht beim Raspi natürlich nicht, das ist ja ein ARM. Ich habe diese Zeile einfach auskommentiert.

Unter Windows gibt es die Funktion "QueryPerformanceCounter()", damit lassen sich Zeiten in µS vom Betriebssystem auslesen. Bei meinem Windows braucht die Funktion zwischen 580 und 1700 µS. Das spielt wohl noch das Windows mit anderen Prozessen dazwischen rein. -> nicht wirklich messbar.

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
var
  ABitmap: TBitmap;
  y: integer;
 
  procedure CopyLine(y: integer);
  var
    pq: pUInt32;
    pz: PByte;
    i: integer;
    bit: byte;
    rev: boolean;
  begin
    pq := pUInt32(Image1.Picture.Bitmap.RawImage.GetLineStart(y));
    pz := ABitmap.RawImage.GetLineStart(y);
    rev := ABitmap.RawImage.Description.BitOrder = riboBitsInOrder;
 
    if rev then
      bit := 1    // Linux
    else bit := 128;  // Win
 
    for i := 0 to ABitmap.Width - 1 do begin
      if (pq^ and $FF000000) = $FF000000 then pz^ := pz^ or bit;
      Inc(pq);
 
      if rev then begin
        bit := bit shl 1;
        if bit = 0 then Begin
          bit := 1;
          Inc(pz);
        end;
      end else begin
        bit := bit shr 1;
        if bit = 0 then Begin
          bit := 128;
          Inc(pz);
        end;
      end;
    end;
  end;
 
var
  td: TDateTime;
 
begin
  if Image1.Picture.Bitmap.PixelFormat <> pf32bit then Exit;
  BorderStyle := bsNone;
  Self.Handle;
 
  Width := Image1.Picture.Bitmap.Width;
  Height := Image1.Picture.Bitmap.Height;
 
  ABitmap := TBitmap.Create;
  ABitmap.Monochrome := True;
  ABitmap.SetSize(Width, Height);
 
  for y := 0 to Image1.Picture.Bitmap.Height - 1 do CopyLine(y);
 
  SetShape(ABitmap);
  ABitmap.FreeImage;
end;   

[Mathias]

Nur die ASM/Intel Direktive geht beim Raspi natürlich nicht, das ist ja ein ARM. Ich habe diese Zeile einfach auskommentiert.

Damit konnte ich das Bitschieben beschleunigen, aber wie du schon sagst, nicht auf ARM.

Bei Intel gibt es den Rol und Ror Befehl, dieser ist fast gleich wie Shl und Shr, der Unterschied, das die Bits wie in einem Ring geschoben werden.
Dazu muss folgendes ersetzt werden.

Code: Alles auswählen

        asm rol bit, 1 end;
//        bit := (bit shl 1) or (bit shr 7);
 

Ich habe noch das SHR/SHL ein wenig optimiert.

Gute Idee, bit wird 0, wen es links überläuft.

Code: Alles auswählen

if rev then
      bit := 1    // Linux
    else bit := 128;  // Win

Dies bringt nichts, da der Compiler 1 shl 7 sowieso raus optimiert.

[MmVisual]

Und es geht sogar noch schneller indem man den Code ein klein wenig umstellt
Win7: 300..xxxµS
Assembler Befehle gehen natürlich nicht, das versteht der RaspberryPi dann nicht mehr.

Der Code wurde dabei sogar kürzer. Die Ersparnis ist, dass man "pz^" nicht erst einlesen und wieder verodern muss. Das ganze Byte für pz^ baue ich mit einem mal.

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
var
  ABitmap: Graphics.TBitmap;
  y: integer;
  li, li2: TLargeInteger;
  pq: pUInt32;
 
  Function IfBitL(i: Integer): Byte; inline;
  Begin
    If (pq[i] and $FF000000) = $FF000000 Then
      result := 1 shl i  // Linux
    Else Result := 0;
  end;
 
  Function IfBitW(i: Integer): Byte; inline;
  Begin
    If (pq[i] and $FF000000) = $FF000000 Then
      result := 128 shr i  // Win
    Else Result := 0;
  end;
 
  procedure CopyLine(y: integer); inline;
  var
    pz: PByte;
    pqe: pUInt32;
  begin
    pq := pUInt32(Image1.Picture.Bitmap.RawImage.GetLineStart(y));
    pz := ABitmap.RawImage.GetLineStart(y);
    pqe := pq + ABitmap.Width;
    If ABitmap.RawImage.Description.BitOrder = riboBitsInOrder Then Begin
      while pq < pqe do begin
        pz^ := IfBitL(0) or IfBitL(1) or IfBitL(2) or IfBitL(3) or IfBitL(4) or IfBitL(5) or IfBitL(6) or IfBitL(7);
        pq += 8;
        pz += 1;
      end;
    End Else Begin
      while pq < pqe do begin
        pz^ := IfBitW(0) or IfBitW(1) or IfBitW(2) or IfBitW(3) or IfBitW(4) or IfBitW(5) or IfBitW(6) or IfBitW(7);
        pq += 8;
        pz += 1;
      end;
    end;
  end;
 
var
  td: TDateTime;
 
begin
  if Image1.Picture.Bitmap.PixelFormat <> pf32bit then Exit;
  BorderStyle := bsNone;
  Self.Handle;
 
  Width := Image1.Picture.Bitmap.Width;
  Height := Image1.Picture.Bitmap.Height;
 
  ABitmap := Graphics.TBitmap.Create;
  ABitmap.Monochrome := True;
  ABitmap.SetSize(Width, Height);
 
  td := Now;
  QueryPerformanceCounter(li);
  for y := 0 to Image1.Picture.Bitmap.Height - 1 do CopyLine(y);
  QueryPerformanceCounter(li2);
  Label1.Caption := IntToStr(li2 - li);
 
  SetShape(ABitmap);
  ABitmap.FreeImage;
end; 

[Mathias]

Vor lauter Optimierungen wurde etwas vergessen. Wird der Splash überhaupt angezeigt, während man irgendwelche Initialisierungen macht ?

Code: Alles auswählen

  with Image1.Picture.Bitmap do begin
    for y := 0 to Height - 1 do begin
      CopyLine(y);
    end;
  end;
  SetShape(ABitmap);
  ABitmap.FreeImage;
 
  for i := 0 to 3000 do begin
    Sleep(1);
    WriteLn(i);
  end;
end;   

Der Splash wird erst angezeigt, nachdem die Schleife mit WriteLn durchgelaufen ist.

[MmVisual]

Das klappt bei mir natürlich schon, mein Startup Code in der .lpr Datei sieht so in etwa aus:

Code: Alles auswählen

  frmSplash := TfrmSplash.create(application);
  frmSplash.show;
  application.ProcessMessages; // to be sure to show the splash
  Application.CreateForm(TfrmMain, frmMain);
  Application.Run; 

Und sobald die Main-App da ist wird ein Timer gestartet, dieser baut erst mal die Datenbankverbindung auf und danach erst wird die Splash-Form versteckt. Der komplette Start der EXE braucht ca. 19 Sekunden auf dem Raspi. Das Main Formular hat ca. 6000 Codezeilen Deklarationen von Komponenten/Klassen/Funktionen - erst dann kommt "implementation". Und bis so viele Komponenten erstellt sind braucht es etwas Zeit. Unter Windows braucht die EXE bei meinem I7/2,7GHz knapp 3 Sekunden, was soweit im grünen Bereich ist.
In der Splash-Form gibt es natürlich überhaupt kein Code der noch irgend welche andere extra Sachen macht, denn sonst bringt das ja nichts.