RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Rund um die LCL und andere Komponenten
Antworten
Mathias
Beiträge: 4851
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunc)
CPU-Target: 64Bit
Wohnort: Schweiz

RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitrag von Mathias »

Wen ich folgenden Code laufen lasse, werden nur die Linien gezeichnet, welche mit Pixels kreiert werden.
Bei der Linie mit PutPixel, bleibt es schwarz.
Verändere ich aber die Grösse des Formes, dann wird die Linie mit PutPixel gezeichnet, aber nicht synchrom mit dem Timer.
Sobald ich aufhöre das Fenster zu Resizen, verändert sich die Linie mit PupPixel nicht mehr.

Code: Alles auswählen

procedure TForm1.PutPixel(x, y: integer; col: TColor);
var
  rgb: ^TColor;
begin
  if (x < 0) or (x > ClientWidth) or (y > ClientHeight) then begin
    Exit;
  end;
 
  with bit.RawImage do begin
    rgb := Pointer(GetLineStart(y));
 
    Inc(rgb, x);
    rgb^ := col;
  end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
  c: integer;
begin
  c := Random($FFFFFF);
 
  for i := 0 to 100 do begin
    bit.Canvas.Pixels[i, 200]:= c;
  end;
 
  for i := 0 to 100 do begin
    bit.Canvas.Pixels[i, 5]:= c;
  end;
 
  for i := 0 to 100 do begin
    PutPixel(i, 10, c);
  end;
 
  Invalidate;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Interval:=50;
  bit := TBitmap.Create;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  bit.Free;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, bit);
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
  bit.Width := ClientWidth;
  bit.Height := ClientHeight;
end;
 
end.


Eigentlich müsste doch

Code: Alles auswählen

 Canvas.Draw(0, 0, bit);
die ganze Bitmap auf den Canvas zeichnen.
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot

Warf
Beiträge: 1424
Registriert: Di 23. Sep 2014, 17:46
OS, Lazarus, FPC: MacOS | Win 10 | Linux
CPU-Target: x86_64
Wohnort: Aachen

Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitrag von Warf »

Erstmal, warum die Putpixel methode so kompliziert?

Code: Alles auswählen

procedure TForm1.PutPixel(x, y: integer; col: TColor);
type
  PColor = ^TColor;
begin
  if (x < 0) or (x > ClientWidth) or (y > ClientHeight) then Exit; // y<0 ??
  PColor(bit.RawData.GetLineStart(y))[x] := col;
end;


Zweitens ist das PixelFormat der bitmap auch 32 Bit (also TColor) und nicht 24 Bit

Code: Alles auswählen

bit.PixelFormat:=pf32bit;


Das mit der Farbe wird aber sowieso nicht funktionieren, da es BGR und nicht RGB ist (oder andersrum?) auf jeden fall ist clRed blau (also außer auf einem Big Endian system).

Zu deinem hauptproblem, Du hast beginUpdate und Endupdate vergessen. Frag mich aber nicht warum das benötigt wird.

Beispiel:

Code: Alles auswählen

procedure TForm1.Timer1Timer(Sender: TObject);
type TColorRec = packed record
  B, G, R: Byte; // 3 byte = 24 bit
end;
  PColorRec = ^TColorRec;
var
  ptr: PColorRec;
  y, x: Integer;
begin     
  bmp.BeginUpdate;
  try
    for y:=0 to bmp.Height-1 do
    begin
      ptr := PColorRec(bmp.RawImage.GetLineStart(y));
      for x:=0 to bmp.Width-1 do
        with ptr[x] do
        begin
          R := Random(256);
          G := Random(256);
          B := Random(256);
        end;
    end;
  finally
    bmp.EndUpdate;
  end;
  Repaint;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp:=TBitmap.Create;
  bmp.PixelFormat:=pf24bit;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0,0,bmp);
end;
 
procedure TForm1.FormResize(Sender: TObject);
begin
  bmp.Width:=ClientWidth;
  bmp.Height:=ClientHeight;
end;

siro
Beiträge: 386
Registriert: Di 23. Aug 2016, 14:25
OS, Lazarus, FPC: Windows 10
CPU-Target: 64Bit
Wohnort: Berlin

Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitrag von siro »

Das BeginUpdate und Endupdate
dient dazu, dass er während des Änderns nicht auf die Idee kommt den Bildinhalt wieder neu aufzubauen.
Innerhalb des Blocks wird also nix gezeichnet, sonst würde er eventuell
bei jeder Pixeländerung ein Invalidate aufrufen, weil sich etwas geändert hat.
So können auch mehrere Komponenten verschachtelt BeginUpdate aufrufen und Änderugen vornehmen.
Erst das letzte EndUpdate löst dann das Neuzeichnen aus weil der UpdateCount 0 wird.

Im Prinzip läuft das so ab:

Code: Alles auswählen

 
Procedure BeginUpdate;
  inc(UpdateCount);
 
Procedure EndUpdate;
  if UpdateCount > 0 then begin
     dec(UpdateCount);
     if UpdateCount = 0 then Invalidate;  // erst jetzt neu zeichnen
  end;


solange UpdateCount 0 bleibt wird er nix neu zeichnen. Der Auslöser fehlt dann quasi
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...

Warf
Beiträge: 1424
Registriert: Di 23. Sep 2014, 17:46
OS, Lazarus, FPC: MacOS | Win 10 | Linux
CPU-Target: x86_64
Wohnort: Aachen

Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitrag von Warf »

siro hat geschrieben:Das BeginUpdate und Endupdate
dient dazu, dass er während des Änderns nicht auf die Idee kommt den Bildinhalt wieder neu aufzubauen.
Innerhalb des Blocks wird also nix gezeichnet, sonst würde er eventuell
bei jeder Pixeländerung ein Invalidate aufrufen, weil sich etwas geändert hat.
So können auch mehrere Komponenten verschachtelt BeginUpdate aufrufen und Änderugen vornehmen.
Erst das letzte EndUpdate löst dann das Neuzeichnen aus weil der UpdateCount 0 wird.

Im Prinzip läuft das so ab:

Code: Alles auswählen

 
Procedure BeginUpdate;
  inc(UpdateCount);
 
Procedure EndUpdate;
  if UpdateCount > 0 then begin
     dec(UpdateCount);
     if UpdateCount = 0 then Invalidate;  // erst jetzt neu zeichnen
  end;


solange UpdateCount 0 bleibt wird er nix neu zeichnen. Der Auslöser fehlt dann quasi


Das generelle Prinzip ist mir schon klar, mich wundert nur warum die Bitmap ein beginupdate und endupdate braucht (ich dachte das wäre nur für das OnChange event), aber die änderungen der Rawdata werden aus dem Timer raus nicht übernommen.

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

Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitrag von Mathias »

Zu deinem hauptproblem, Du hast beginUpdate und Endupdate vergessen. Frag mich aber nicht warum das benötigt wird.

Das war die Lösung, aber ein Rätsel ist es mir doch noch, Pixels und PutPixel schreiben beide in die Bitmap, aber wieso wurden nur die Pixel mit Pixels übernommen ?
Zeichnet Canvas.Draw nur Ausschnitte der Bitmap ?

Erstmal, warum die Putpixel methode so kompliziert?

Stimmt, dies kann man einfacher machen, aber mir geht es mal darum, wieso das die Pixel nicht gezeichnet werden.

Zweitens ist das PixelFormat der bitmap auch 32 Bit (also TColor) und nicht 24 Bit

Die RawImage ist komischerweise 32Bit.

Code: Alles auswählen

  WriteLn(bit.PixelFormat); // --> pf24bit
  WriteLn(bit.RawImage.Description.BitsPerPixel); // --> 32

Vielleicht liegt dies an Linux.

Wen ich folgende probiere, bleibt das Form erst mal grau. Sobald ich die grösse des Forme ändere, dann wird die Ausgabe sichtbar, aber es schaltet mir wieder auf pf24bit zurück.
Wen ich versuche pf32Bit bei Create zu setzen, das gleiche Problem.

Code: Alles auswählen

procedure TForm1.FormResize(Sender: TObject);
begin
  bit.Width := ClientWidth;
  bit.Height := ClientHeight;
  bit.PixelFormat:=pf32bit;
end;


TBitmap. das ominöse Ding. :roll:
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot

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

Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitrag von Mathias »

Ich habe PutPixel ein wenig geändert, somit stimmt RGB/BGR, auch geht es mit Linux und Windows(Wine).

Code: Alles auswählen

procedure TForm1.PutPixel(x, y: integer; col: TColor);
var
  r, g, b: byte;
  p: PByte;
begin
  b := col;
  g := col shr 8;
  r := col shr 16;
 
  p := bit.RawImage.GetLineStart(y);
  Inc(p, x * (bit.RawImage.Description.BitsPerPixel div 8));
  p^ := r;
  Inc(p);
  p^ := g;
  Inc(p);
  p^ := b;
  Inc(p);
  p^ := $FF;
end;
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot

Warf
Beiträge: 1424
Registriert: Di 23. Sep 2014, 17:46
OS, Lazarus, FPC: MacOS | Win 10 | Linux
CPU-Target: x86_64
Wohnort: Aachen

Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitrag von Warf »

Mathias hat geschrieben:Ich habe PutPixel ein wenig geändert, somit stimmt RGB/BGR, auch geht es mit Linux und Windows(Wine).

Gute Idee, aber überschreibt bei einer 24 bit RawImage das letzte p^ := $FF das rot des nächsten Pixels?
Also eher so

Code: Alles auswählen

procedure TForm1.PutPixel(x, y: integer; col: TColor);
var
  c: record
  r, g, b, a: byte; // oder andersrum? kann grad nicht testen
  end;
  p: PByte;
  ColSize: Integer;
begin
  ColSize := bit.RawImage.Description.BitsPerPixel div 8;
  c.b := col;
  c.g := col shr 8;
  c.r := col shr 16;
  c.a := $FF;
  bit.BeginUpdate; // extra schadet nie
  try
    p := PByte(bit.RawImage.GetLineStart(y)) + x * ColSize);
    Move(c, p^, ColSize);
  finally
    bit.EndUpdate;
  end;
end;

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

Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitrag von Mathias »

Gute Idee, aber überschreibt bei einer 24 bit RawImage das letzte p^ := $FF das rot des nächsten Pixels?

Oder noch schlimmer, eine Zugriffsverletzung am Pixel rechts-unten.

So, ich habe es korrigiert.

Code: Alles auswählen

procedure TForm1.PutPixel(x, y: integer; col: TVector3f);
var
  p: PByte;
  tc: TColor;
begin
  tc := col.ToInt;
 
  p := bit.RawImage.GetLineStart(y);
  Inc(p, x * (bit.RawImage.Description.BitsPerPixel div 8));
  p^ := tc shr 16;
  Inc(p);
  p^ := tc shr 8;
  Inc(p);
  p^ := tc;
end;

Das Ergebnis kann sich langsamen sehen lassen. Mein Ziel, eine Vektor-Grafik mit Perspektiven-Korrektur und Z-Puffer.
Das ganze sollte zeigen, was einem OpenGL abnimmt.

Hier noch die ganze Source, wen jemand dies interessiert. :wink:
https://github.com/sechshelme/Lazarus-OpenGL-3.3-Tutorial/blob/master/60_-_Vektoren_und_Matrizen_(_no_OpenGL_)/40_-_Vektoren_Cube_Z-Buffer_TImages/unit1.pas
Dateianhänge
Bildschirmfoto vom 2018-06-11 18-03-44.png
Bildschirmfoto vom 2018-06-11 18-03-44.png (32.19 KiB) 531 mal betrachtet
Mit Lazarus sehe ich gün
Mit Java und C/C++ sehe ich rot

Antworten