TRawImage und TBitmap

[Mathias]

Ich will ein Bitmap direkt über Rawimage über einen Timer befüllen. Aber leider wird es dies nicht gemacht, dies sieht man im Anhang.
Der Timer würde funktionieren, ansonsten würde man das Quadrat nicht sehen.

Aber komischerweise funktioniert das Befüllen in FormPaint.

Was läuft da falsch ?
Wir da irgendwie ein doppelter Puffer oder sonst was verwendet ?

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Interval := 100;
  bitmap := TBitmap.Create;
  bitmap.SetSize(320, 200);
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to 1000000 do begin
    bitmap.RawImage.Data[Random(10000) + 10000] := Random($FF); // wird gemacht
  end;
  Canvas.Draw(10, 10, bitmap);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to 1000000 do begin
    bitmap.RawImage.Data[Random(10000)] := Random($FF); // wird nicht gemacht
  end;

  bitmap.Canvas.Brush.Color := Random($FFFFFF);
  bitmap.Canvas.Rectangle(10, 10, 50, 50);

  for i := 0 to 1000000 do begin
    bitmap.RawImage.Data[Random(10000)] := Random($FF); // wird nicht gemacht
  end;
  Repaint;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bitmap.Free;
end;

[wennerer]

Hallo Matthias,
in einer Form kannst du nur in die Paint Procedure zeichnen. Mit jedem Invalidate wird der Canvas wieder gelöscht und nur das was in der Paint steht ist zu sehen.
Alternativ kannst du in eine Image zeichnen.

Code: Alles auswählen

Image1.Canvas.Draw(10, 10, bitmap);

Das sollte gehen.

Viele Grüße
Bernd

[Mathias]

in einer Form kannst du nur in die Paint Procedure zeichnen.

Ich mache dies ja in der FormPaint. Der Timer schreibt in die Rohdaten der bitmap.

Ich habe es jetzt mit dem Umweg über TImage gemacht und es scheint zu klappen.

Code: Alles auswählen

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Interval := 100;
  bitmap := TBitmap.Create;
  bitmap.SetSize(320, 200);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to 1000000 do begin
    bitmap.RawImage.Data[Random(5000)] := Random($FF);
  end;

  Image1.Canvas.Draw(10, 10, bitmap);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bitmap.Free;
end;  

[Mathias]

Ich habe etwas übersehen, das Random-Muster wird nur 1x gezeichnet.
Das Muster müsste eigentlich flimmern.

[Mathias]

Habe das Problem gelöst, ich habe einen kleinen Umweg über OpenGL gemacht.
Und es macht, was ich will.
Dies hat sogar noch den Vorteil, das ich meine Rohdaten, welche in einer Byte Array sind direkt ohne Umwandlung in den FrameBuffer kriege.
Meine Image hat ein Byte pro Pixel und ein Canvas hat für ein Pixel ein TColor.

Code: Alles auswählen

var
  buffer: array[0..ImgWidth * ImgHeight - 1] of byte;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClientWidth := ImgWidth;
  ClientHeight := ImgHeight;
  Timer1.Interval := 100;
  OpenGLControl1.Align := alClient;
  OpenGLControl1.MakeCurrent;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to ImgWidth * ImgHeight - 1 do begin
    buffer[i] := Random($FF);
  end;

  glDrawPixels(ImgWidth, ImgHeight, GL_LUMINANCE, GL_UNSIGNED_BYTE, @buffer);
  OpenGLControl1.SwapBuffers;
end;             

[wennerer]

Hallo Matthias,
hab da noch etwas herumprobiert. Was hältst denn von der Variante:

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, FPimage, IntfGraphics,
  StdCtrls, ExtCtrls, LCLIntf, GraphType;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    BitTextur: TBitmap;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
 Timer1.Enabled:= true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Timer1.Enabled:= false;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, BitTextur);
  if assigned(BitTextur) then FreeAndNil(BitTextur);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
const
    ASize    = 500;
var x, y     : integer;
    aColor   : TColor;
    aFPColor : TFPColor;
    AImage   : TLazIntfImage;
    ARawImage: TRawImage;

begin
 if assigned(BitTextur) then exit;
 BitTextur := TBitmap.Create;
 ARawImage.Init;
 ARawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(ASize, ASize);
 ARawImage.CreateData(True);
 AImage := TLazIntfImage.Create(0, 0);
 AImage.SetRawImage(ARawImage);

 for y := 0 to AImage.Height - 1 do
  begin
    for x := 0 to AImage.Width - 1 do
     begin
      aColor := RGB(Random(255),Random(255),Random(255));
      aFPColor := TColorToFPColor(aColor);
      AImage.Colors[x, y] := aFPColor;
     end;
  end;

 BitTextur.LoadFromIntfImage(AImage);
 Invalidate;
 AImage.Free;
end;


end.

Viele Grüße
Bernd

[wp_xyz]

@wennerer: Die Zwischenschritte mit dem RawImage kannst du dir sparen, denn du kannst mit einem einzigen Befehl (CreateIntfImage) ein TLazIntfImage aus einem TBitmap erzeugen:

Code: Alles auswählen

var
  AImage: TLazIntfImage;
...
  BitTextur := TBitmap.Create;
  AImage := BitTexture.CreateIntfImage;
  // ... etwas mit dem LazIntfImage machen
  BitTextur.LoadFromIntfImage(AImage);  // IntfImage ins Bitmap zurück laden
  AImage.Free;

[wennerer]

Hallo wp_xyz,
Danke für den Tipp. Hab es natürlich gleich mal getestet:

Code: Alles auswählen

procedure TForm1.Timer1Timer(Sender: TObject);
const
    ASize    = 500;
var x, y     : integer;
    aColor   : TColor;
    aFPColor : TFPColor;
    AImage   : TLazIntfImage;
    //ARawImage: TRawImage;

begin
 if assigned(BitTextur) then exit;
 BitTextur := TBitmap.Create;
 BitTextur.SetSize(ASize,ASize);
 AImage := BitTextur.CreateIntfImage;
 (*ARawImage.Init;
 ARawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(ASize, ASize);
 ARawImage.CreateData(True);
 AImage := TLazIntfImage.Create(0, 0);
 AImage.SetRawImage(ARawImage); *)

 for y := 0 to AImage.Height - 1 do
  begin
    for x := 0 to AImage.Width - 1 do
     begin
      aColor := RGB(Random(255),Random(255),Random(255));
      aFPColor := TColorToFPColor(aColor);
      AImage.Colors[x, y] := aFPColor;
     end;
  end;

 BitTextur.LoadFromIntfImage(AImage);
 Invalidate;
 AImage.Free;
end;          

Viele Grüße
Bernd

[Mathias]

Kann man das Create und Free nicht in den Constructor und Destructor auslagern. Man sollte nach Möglichkeit verhinder nach jedem Frames neuen Speicher anzulegen.

[wennerer]

Meinst du so:

Code: Alles auswählen

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, FPimage, IntfGraphics,
  StdCtrls, ExtCtrls, LCLIntf, GraphType;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    BitTextur: TBitmap;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
 Timer1.Enabled:= true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Timer1.Enabled:= false;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
 BitTextur.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
const  ASize    = 500;
begin
 BitTextur := TBitmap.Create;
 BitTextur.SetSize(ASize,ASize);
 BitTextur.Canvas.Brush.Color:= clForm;
 BitTextur.Canvas.FillRect(0,0,ASize,ASize);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, BitTextur);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var x, y     : integer;
    aColor   : TColor;
    aFPColor : TFPColor;
    AImage   : TLazIntfImage;
begin

 AImage := BitTextur.CreateIntfImage;
 for y := 0 to AImage.Height - 1 do
  begin
    for x := 0 to AImage.Width - 1 do
     begin
      aColor := RGB(Random(255),Random(255),Random(255));
      aFPColor := TColorToFPColor(aColor);
      AImage.Colors[x, y] := aFPColor;
     end;
  end;

 BitTextur.LoadFromIntfImage(AImage);
 Invalidate;
 AImage.Free;
end;


end.

Das scheint auch zu funktionieren.

Viele Grüße
Bernd

[Mathias]

Code: Alles auswählen

 AImage := BitTextur.CreateIntfImage;

Dies kann man auch noch in den Constructor verschieben.