Splash Screen transparant?

Rund um die LCL und andere Komponenten
MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Splash Screen transparant?

Beitrag von 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 :shock: (deshalb "halb")
EleLa - Elektronik Lagerverwaltung - www.elela.de

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Splash Screen transparant?

Beitrag von 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.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Splash Screen transparant?

Beitrag von Mathias »

Jetzt sollte es universell funktionieren, auch die Width des Forms hatte einen Einfluss.
Dateianhänge
Fenster_als_Bitmap_3.tar.gz
(187.16 KiB) 69-mal heruntergeladen
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Splash Screen transparant?

Beitrag von MmVisual »

Bein Win7 sieht es nicht gut aus, dafür jetzt beim Raspi:
Splash_V3_Win7.png
Splash_V3_Win7.png (72.61 KiB) 2129 mal betrachtet

Splash_V3_Raspi.png
Splash_V3_Raspi.png (68.08 KiB) 2129 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)
EleLa - Elektronik Lagerverwaltung - www.elela.de

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Splash Screen transparant?

Beitrag von Mathias »

Hast du den Post weiter oben, mit dem Unterschied Linux / Win beachtet ?
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Splash Screen transparant?

Beitrag von MmVisual »

Welchen Post meinst Du? Ich habe nur das ZIP von 23:34 geladen und ohne Änderungen übersetzt.
EleLa - Elektronik Lagerverwaltung - www.elela.de

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Splash Screen transparant?

Beitrag von Mathias »

MmVisual hat geschrieben: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. :oops:

Im Anhang der korrigierte Code.
Dateianhänge
Fenster_als_Bitmap_4.tar.gz
(187.2 KiB) 62-mal heruntergeladen
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Splash Screen transparant?

Beitrag von 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;
EleLa - Elektronik Lagerverwaltung - www.elela.de

MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Splash Screen transparant?

Beitrag von MmVisual »

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

Hier das Projekt, Incl Zeitmessung:
Fenster_als_Bitmap_5.zip
(187.38 KiB) 66-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.
EleLa - Elektronik Lagerverwaltung - www.elela.de

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Splash Screen transparant?

Beitrag von Mathias »

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

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. :shock:

Wen man bedenkt, wie gemütlich es mit Pixels[...] war, dies ging nach deinem Beschreib 7'000ms. :shock:
Schlussendlich eine Beschleunigung von fast 2'000 !
Da sieht man wieder, was man aus einer Kiste rausholen kann, wenn optimiert. :wink:
Dateianhänge
Fenster_als_Bitmap.tar.gz
(213.33 KiB) 59-mal heruntergeladen
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Splash Screen transparant?

Beitrag von MmVisual »

Wow wieder schneller :idea:

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;   
EleLa - Elektronik Lagerverwaltung - www.elela.de

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Splash Screen transparant?

Beitrag von 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.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Splash Screen transparant?

Beitrag von MmVisual »

Und es geht sogar noch schneller indem man den Code ein klein wenig umstellt :mrgreen:
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// Linux
    Else Result := 0;
  end;
 
  Function IfBitW(i: Integer): Byte; inline;
  Begin
    If (pq[i] and $FF000000) = $FF000000 Then
      result := 128 shr// 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;
EleLa - Elektronik Lagerverwaltung - www.elela.de

Mathias
Beiträge: 6160
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Splash Screen transparant?

Beitrag von 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.
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot

MmVisual
Beiträge: 1445
Registriert: Fr 10. Okt 2008, 23:54
OS, Lazarus, FPC: Winuxarm (L 3.0 FPC 3.2)
CPU-Target: 32/64Bit

Re: Splash Screen transparant?

Beitrag von 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.
EleLa - Elektronik Lagerverwaltung - www.elela.de

Antworten