RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Rund um die LCL und andere Komponenten

RawImage Zugriff auf TBitmap wird nicht gezeichnet.

Beitragvon Mathias » 7. Jun 2018, 21:57 RawImage Zugriff auf TBitmap wird nicht gezeichnet.

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
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Warf » 8. Jun 2018, 00:20 Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

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;
Warf
 
Beiträge: 985
Registriert: 23. Sep 2014, 16:46
Wohnort: Aachen
OS, Lazarus, FPC: Mac OSX 10.11 | Win 10 | FPC 3.0.0 | L trunk | 
CPU-Target: x86_64, i368, ARM
Nach oben

Beitragvon siro » 8. Jun 2018, 13:02 Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

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...
siro
 
Beiträge: 315
Registriert: 23. Aug 2016, 13:25
Wohnort: Berlin
OS, Lazarus, FPC: Windows 7 Windows 8.1 Windows 10 | 
CPU-Target: 64Bit
Nach oben

Beitragvon Warf » 8. Jun 2018, 14:42 Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

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.
Warf
 
Beiträge: 985
Registriert: 23. Sep 2014, 16:46
Wohnort: Aachen
OS, Lazarus, FPC: Mac OSX 10.11 | Win 10 | FPC 3.0.0 | L trunk | 
CPU-Target: x86_64, i368, ARM
Nach oben

Beitragvon Mathias » 8. Jun 2018, 17:22 Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

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: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Mathias » 10. Jun 2018, 17:29 Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

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
Mathias
 
Beiträge: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

Beitragvon Warf » 11. Jun 2018, 00:51 Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

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;
Warf
 
Beiträge: 985
Registriert: 23. Sep 2014, 16:46
Wohnort: Aachen
OS, Lazarus, FPC: Mac OSX 10.11 | Win 10 | FPC 3.0.0 | L trunk | 
CPU-Target: x86_64, i368, ARM
Nach oben

Beitragvon Mathias » 11. Jun 2018, 17:12 Re: RawImage Zugriff auf TBitmap wird nicht gezeichnet.

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
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: 4342
Registriert: 2. Jan 2014, 17:21
Wohnort: Schweiz
OS, Lazarus, FPC: Linux (die neusten Trunc) | 
CPU-Target: 64Bit
Nach oben

• Themenende •

Zurück zu Komponenten und Packages



Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 4 Gäste

porpoises-institution
accuracy-worried