Splash Screen transparant?

Rund um die LCL und andere Komponenten

Re: Splash Screen transparant?

Beitragvon MmVisual » 20. Apr 2018, 21:35 Re: Splash Screen transparant?

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")
MmVisual
 
Beiträge: 996
Registriert: 10. Okt 2008, 22:54
OS, Lazarus, FPC: Winux (L 1.6 FPC 3) | 
CPU-Target: 32/64Bit
Nach oben

Beitragvon Mathias » 20. Apr 2018, 21:58 Re: Splash Screen transparant?

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4101
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Mathias » 20. Apr 2018, 22:34 Re: Splash Screen transparant?

Jetzt sollte es universell funktionieren, auch die Width des Forms hatte einen Einfluss.
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4101
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon MmVisual » 21. Apr 2018, 05:53 Re: Splash Screen transparant?

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

Splash_V3_Raspi.png


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)
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
MmVisual
 
Beiträge: 996
Registriert: 10. Okt 2008, 22:54
OS, Lazarus, FPC: Winux (L 1.6 FPC 3) | 
CPU-Target: 32/64Bit
Nach oben

Beitragvon Mathias » 21. Apr 2018, 07:15 Re: Splash Screen transparant?

Hast du den Post weiter oben, mit dem Unterschied Linux / Win beachtet ?
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4101
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon MmVisual » 21. Apr 2018, 11:17 Re: Splash Screen transparant?

Welchen Post meinst Du? Ich habe nur das ZIP von 23:34 geladen und ohne Änderungen übersetzt.
MmVisual
 
Beiträge: 996
Registriert: 10. Okt 2008, 22:54
OS, Lazarus, FPC: Winux (L 1.6 FPC 3) | 
CPU-Target: 32/64Bit
Nach oben

Beitragvon Mathias » 21. Apr 2018, 12:41 Re: Splash Screen transparant?

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.
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4101
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon MmVisual » 21. Apr 2018, 14:32 Re: Splash Screen transparant?

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
 
Beiträge: 996
Registriert: 10. Okt 2008, 22:54
OS, Lazarus, FPC: Winux (L 1.6 FPC 3) | 
CPU-Target: 32/64Bit
Nach oben

Beitragvon MmVisual » 21. Apr 2018, 14:40 Re: Splash Screen transparant?

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



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.
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
MmVisual
 
Beiträge: 996
Registriert: 10. Okt 2008, 22:54
OS, Lazarus, FPC: Winux (L 1.6 FPC 3) | 
CPU-Target: 32/64Bit
Nach oben

Beitragvon Mathias » 21. Apr 2018, 16:41 Re: Splash Screen transparant?

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:
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4101
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon MmVisual » 21. Apr 2018, 18:07 Re: Splash Screen transparant?

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;   
MmVisual
 
Beiträge: 996
Registriert: 10. Okt 2008, 22:54
OS, Lazarus, FPC: Winux (L 1.6 FPC 3) | 
CPU-Target: 32/64Bit
Nach oben

Beitragvon Mathias » 21. Apr 2018, 19:06 Re: Splash Screen transparant?

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4101
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon MmVisual » 21. Apr 2018, 19:39 Re: Splash Screen transparant?

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;
MmVisual
 
Beiträge: 996
Registriert: 10. Okt 2008, 22:54
OS, Lazarus, FPC: Winux (L 1.6 FPC 3) | 
CPU-Target: 32/64Bit
Nach oben

Beitragvon Mathias » 21. Apr 2018, 20:22 Re: Splash Screen transparant?

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 gün
Mit Java und C/C++ sehe ich rot
Mathias
 
Beiträge: 4101
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon MmVisual » 21. Apr 2018, 20:31 Re: Splash Screen transparant?

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.
MmVisual
 
Beiträge: 996
Registriert: 10. Okt 2008, 22:54
OS, Lazarus, FPC: Winux (L 1.6 FPC 3) | 
CPU-Target: 32/64Bit
Nach oben

» Weitere Beiträge siehe nächste Seite »
VorherigeNächste

Zurück zu Komponenten und Packages



Wer ist online?

Mitglieder in diesem Forum: Google [Bot] und 1 Gast

porpoises-institution
accuracy-worried