RawImage Zugriff auf TBitmap wird nicht gezeichnet.

[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.

[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]

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

[Warf]

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]

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.

[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;

[Warf]

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]

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.
https://github.com/sechshelme/Lazarus-O ... /unit1.pas