Bitmap erstellen und mit Direct2D zeichnen

[milos]

Hallo

ich suche eine Lösung um ein Bitmap zu erstellen und mit Direct2D zu zeichnen.
Gibt es eine wirklich schnelle Lösung dafür? 100+ Bilder pro Sekunde wären nice.

Momentan mach ich das ganz einfach, kriege aber nicht viele Bilder.
Ich nehme ein Bitmap nehme 2 For schleifen, nehme jedes Pixel und zeichne es mit Direct2D.
Ihr könnt euch bestimmt vorstellen wie langsam das ist...

MfG

[Der schöne Günther]

Schau doch mal unter Samples\Delphi\Vcl\Direct2D.

[Medium]

Zitat:

Zitat von milos (Beitrag 1251536)

nehme jedes Pixel

Mittels TBitmap.Canvas.Pixels[]? Dann lässt sich da schon allein durch Nutzung von .Scanline ein Gewinn um größere Faktoren erreichen. (Beispiele dazu gibt's in der DP mehr als nötig.) >100FPS wird bei größeren Bildern aber dennoch kaum drin sein, zumindest nicht mit der normalen WinAPI. (Und die wenigsten TFT Bildschirme stellen >60Hz (=FPS) überhaupt dar, wenn man mal schon ganz davon absieht, dass es ein Mensch ab spätestens 60Hz eh kaum noch wahrnimmt.)

[milos]

Danke für den Tipp mit ScanLine. Habe ne weile gebraucht bis ich es verstanden habe, aber habe es endlich hingekriegt einen brauchbaren Test zu machen. :D

Werde bald die Pixels variante mit der ScanLine variante umtauschen, mal sehen was sich an der Performance verändert ^^

MfG

[TiGü]

Handelt es sich denn bei jedem Frame um ein neu generiertes Bitmap?
Dann ist hier der Flaschenhals!

Das Darstellen des immer gleichen Bitmaps geht auch mit mehr als 100 FPS, je nach Grafikhardware und Größe des Bitmaps.

Wenn du magst, kannst du ja mal ein kleines Beispielprojekt anhängen!

[milos]

Hab mal ein kleines Testprojekt erstellt um die Performance von ScanLine mit der von Pixels zu vergleichen.

Ich glaube jedoch ich mache was falsch, da die Performance nur minimal besser ist :/

Habe das Projekt in eine Zip gepackt und hochgeladen. Das kompilat ist nicht in der Zip da sie sonst zu gross gewesen wäre um sie hier hochzuladen.
Im "Debug" Ordner habe ich 5 Bilder in verschiedenen Auflösungen reingetan.

Edit: Der Code wurde schnell geschrieben und wird später nicht mehr gebraucht. Ist nur für Testzwecke gedacht.
Edit2: Ja die Bitmaps werden ein mal geladen und werden nicht (bzw. sehr selten) während der Laufzeit verändert werden aber an verschiedenen Positionen angezeigt.

Edit3: In diesem Beitrag ist leider eine falsche version des Projekts ^^ Weiter unten ist die richtige

[nuclearping]

Die Funktionen des angehängten Projekts sind leer.

Delphi-Quellcode:

procedure TForm1.DrawPixels;
begin

end;

procedure TForm1.DrawScanLine;
begin

end;

[milos]

Oh lol, da hab ich wohl ernsthaft vergessen abzuspeichern bevor ich es gepackt habe :stupid:

Danke fürs melden ^^

[nuclearping]

Was willst du eigentlich machen? Das wird aus deinem Code irgendwie nicht ersichtlich.

In dem Code lädst du eine Bitmap und zeichnest sie Pixel für Pixel über TDirect2DCanvas auf die Form, mit beiden Funktionen.

Du könntest zB auch mit BitBlt die Bitmap in einem Rutsch auf die Form zeichnen. Wozu der Umweg?

[TiGü]

Das ist ja mal wirklich gruselig! Pixel für Pixel! :shock:

Hier mal ein kleiner Ansatz, wie es schneller geht.
Da ist aber noch Luft nach oben.

Delphi-Quellcode:

procedure TForm1.Loop(CountTo: integer);
var
  c : integer;
begin
  c := 0;
  while c < CountTo do
  begin
    Invalidate;
    Application.ProcessMessages;
    inc(c);
    if c mod 10 = 0 then
      edit1.Text := inttostr(c);
  end;
  edit1.Text := 'done';
end;

procedure TForm1.WMPaint(var Message: TWMPaint);
var
  PaintStruct: TPaintStruct;
begin
  BeginPaint(Handle, PaintStruct);
  try
    FCanvas.BeginDraw;
    try
      FCanvas.StretchDraw(ClientRect, FBitmap);
    finally
      FCanvas.EndDraw;
    end;
  finally
    EndPaint(Handle, PaintStruct);
  end;
end;

[milos]

Ich finds ja genau so gruselig wie ihr alle aber ich kenne keine andere Methode es so hinzukrigen wie ich es gerne haben will...

Am liebsten wäre es mir sowieso ohne TBitmap auszukommen um auch Transparente Ebenen anwenden zu können.

Im Anhang ist ein Bild wie ich es gerne hätte und wie es bisher auch funktioniert, nur halt mit der langsamen Pixels Methode... :/

Eigentlich sind das einfach nur 2 Bitmaps (Eigene Klasse) die Pixel für Pixel gezeichnet werden.

[nuclearping]

Also du willst ein Bitmap über ein anderes zeichnen?

[milos]

Ja, das sollte auch möglich sein.

Das Bild oben zeigt einen Hintergrund (256x144) und ein kleines Objekt.
Wie man sehen kann werden die Bilder so gestreckt das man jedes Pixel klar sieht, und genau das will ich so haben.

Edit: Ziel wäre eine kleine Game-Engine.

[nuclearping]

Wenn's um Game-Engine geht: Hast du dir schon Andorra 2D angeschaut? Das ist eine DirectX / OpenGL Sprite Engine für Delphi.

Andernfalls: Für das was du machen willst, kannst du auch StretchBlt verwenden.

Noch ein Wort zu ScanLine. Wenn man mit ScanLine zeichnen will, macht man das in der Regel nach dem Prinzip:

Delphi-Quellcode:

type
  TRGB = record
    R, G, B: Byte;
  end;
  PRGB = ^TRGB;

var
  Bmp: TBitmap;
  x, y: Integer;
  RGB: PRGB;
  c: Byte;
begin
  Randomize;

  Bmp := TBitmap.Create;
  try
    Bmp.PixelFormat := pf24Bit;
    Bmp.Width := 1000;
    Bmp.Height := 100;
    for y := 0 to Bmp.Height - 1 do
      begin
        RGB := Bmp.ScanLine[y];
        for x := 0 to Bmp.Width - 1 do
           begin
             c := Round(255 / 100 * x / Bmp.Width * 100);
             RGB^.r := c; // Random(255);
             RGB^.g := c; // Random(255);
             RGB^.b := c; // Random(255);

             Inc(RGB);
           end;
      end;
    Bmp.SaveToFile('C:\Temp\Test.bmp');
  finally
    FreeAndNil(Bmp);
  end;
end;

ScanLine liefert dir einen Zeiger zurück. Das dient aber nicht nur zum lesen. Sondern das heisst auch, dass alle Werte, die du in / an / auf dem Zeiger manipulierst, direkt wieder in diesen Speicherbereich zurückgeschrieben werden.

In diesem Fall sind es die RGB-Werte für die Palette, die direkt wieder im Bitmap-Speicher landen.

[TiGü]

Zitat:

Zitat von milos (Beitrag 1251935)

Ich finds ja genau so gruselig wie ihr alle aber ich kenne keine andere Methode es so hinzukrigen wie ich es gerne haben will...

Ich weiß, aller Anfang ist schwer, daher hier ein Anstoß.
Hintergrund- und Vordergrundobjekt sind in diesem simplen Beispiel gleich.
Sobald das Prinzip aber verstanden ist, kannst du auch verschiedene Quellbitmaps nehmen.

Delphi-Quellcode:

unit MainForm;

interface

uses
  Winapi.Windows, Winapi.D2D1, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Direct2D, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FCanvas : TDirect2DCanvas;
    FBitmap : TBitmap;
    FGameObject : ID2D1Bitmap;
  protected
     procedure CreateWnd; override;
     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  public
     property Canvas: TDirect2DCanvas read FCanvas;
     procedure Draw;
     procedure Loop(CountTo : integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  OD: TOpenDialog;
begin
  OD := TOpenDialog.Create(self);
  OD.Filter := 'Bitmap|*.bmp';

  if OD.Execute then
  begin
    FBitmap.LoadFromFile(OD.FileName);
    FGameObject := Canvas.CreateBitmap(FBitmap);
  end;
  Invalidate;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  loop(10);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  loop(100);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  loop(1000);
end;

procedure TForm1.CreateWnd;
begin
  inherited;
  FCanvas := TDirect2DCanvas.Create(Handle);
  FBitmap := TBitmap.Create;

  FBitmap.LoadFromFile('5.bmp');
  FGameObject := Canvas.CreateBitmap(FBitmap);
end;

procedure TForm1.Draw;
var
  D2DRect : TD2DRectF;
  GameObjectRect : TRect;

  function GetBackgroundSize : TD2DRectF;
  begin
    Result.Top    := ClientRect.Top;
    Result.Left   := ClientRect.Left;
    Result.Right  := ClientRect.Right;
    Result.Bottom := ClientRect.Bottom;
  end;

  function GetObjectSize : TD2DRectF;
  begin
    GetCursorPos(GameObjectRect.TopLeft);

    GameObjectRect.TopLeft := ScreenToClient(GameObjectRect.TopLeft);

    Result.Top    := GameObjectRect.Top;
    Result.Left   := GameObjectRect.Left;
    Result.Right  := GameObjectRect.Left + FBitmap.Width div 8;
    Result.Bottom := GameObjectRect.Top  + FBitmap.Height div 8;
  end;

begin
  if Assigned(FGameObject) then
  begin
    D2DRect := GetBackgroundSize;
    Canvas.RenderTarget.DrawBitmap(FGameObject, @D2DRect);

    D2DRect := GetObjectSize;
    Canvas.RenderTarget.DrawBitmap(FGameObject, @D2DRect, 0.5);
  end;
end;

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

procedure TForm1.Loop(CountTo: integer);
var
  c : integer;
begin
  c := 0;

  while c < CountTo do
  begin
    Invalidate;
    Application.ProcessMessages;
    Inc(c);

    if c mod 25 = 0 then
      edit1.Text := inttostr(c);
  end;

  edit1.Text := 'done';
end;

procedure TForm1.WMPaint(var Message: TWMPaint);
var
  PaintStruct: TPaintStruct;
begin
  BeginPaint(Handle, PaintStruct);
  try
    Canvas.BeginDraw;
    try
      Draw;
    finally
      Canvas.EndDraw;
    end;
  finally
    EndPaint(Handle, PaintStruct);
  end;
end;

procedure TForm1.WMSize(var Message: TWMSize);
var
  NewSize : TD2D1SizeU;
begin
  if Assigned(Canvas) then
  begin
    NewSize := D2D1SizeU(ClientWidth, ClientHeight);
    ID2D1HwndRenderTarget(Canvas.RenderTarget).Resize(NewSize);
  end;

  inherited;
end;

end.

[TiGü]

@milos:

Konntest du damit was anfangen?

[milos]

Erstmal vielen Dank, dass du dir Mühe gegeben hast und mir sogar einen Code geschrieben hast ^^

Leider habe ich momentan nicht viel Zeit für mein Privatprojekt und konnte den Code deshalb nur einmal kurz kompillieren. Was ich bisher gesehen hab, passt mir eigentlich schon ganz gut, nur hätte ich gerne dass wenn ich ein Bitmap habe was z.B. 64x64 pixel ist und es dann gestreckt wird, wirklich jedes Pixel gestreckt wird wie man es bei dem Bild was ich hochgeladen habe ganz gut sehen kann. Dort wurde ein Pixel auf 10 gestreckt. (also pixel für pixel und nicht das ganze Bild verzerrt)

Wäre dies noch möglich?

[TiGü]

Habe ich nicht verstanden? :gruebel:

Zeige mal ein Screenshot vom Ist-Zustand und dann bastle per Zeichenprogramm mal ein Soll-Zustand.

[nuclearping]

Hat er doch schon oben, das Beispielbild.

@milos: Hast du dir schonmal - wie oben erwähnt - StretchBlt angeschaut?

Wenn du ein Bild nach einem bestimmten Filter strecken willst (also in dem Fall "Pixel-Wiederholung"), brauchst du einen Algorithmus, der das erledigt. Ich weiß nicht, ob die VampyreImagingLibrary sowas dabei hat oder die Graphics32.

Andernfalls hast du hier schon alle Werkzeuge genannt bekommen, die du dafür brauchst, um das schnell und effizient zu machen. Stichwort: ScanLine. :mrgreen:

Wenn du willst, dass in einem Zielbild ein Pixel aus dem Quellbild in einem 5x5- oder 10x10-Block gezeichnet wird, musst du mit entsprechenden Schleifen jeden Pixel im Quellbild auslesen und im Zielbild diesen Pixel im gewünschten Block "nachbilden".

Delphi-Quellcode:

ScanLineP := Bitmap.ScanLine[Y]

liefert dir einen Zeiger zu einer RGB(A)-"Y-Zeile". Und mit

Delphi-Quellcode:

Inc(ScanLineP);

kannst du dich in der X-Spalte vorwärtsbewegen.
Wenn du also etwas von Bild1 auf Bild2 per ScanLine zeichnen willst, brauchst du ... ? Richtig, zwei ScanLine-Zeiger. :mrgreen:

Delphi-Quellcode:

uses
  Winapi.Windows;

type
  PRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = Array[0..0] of TRGBQuad

var
  ScanLine_Source,
  ScanLine_Target: PRGBQuadArray;
  X, Y: Integer;

begin
  // Annahme: Bitmap1.Width = Bitmap2.Width und Bitmap1.Height = Bitmap2.Height!
  for Y := 0 to Bitmap1.Height - 1 do
    begin
      ScanLine_Source := Bitmap1.ScanLine[Y];
      ScanLine_Target := Bitmap2.ScanLine[Y];
      for X := 0 to Bitmap1.Width - 1 do
        begin
          ScanLine_Target[X]^ := ScanLine_Source[X]^;          
          { Das gleiche wie
          ScanLine_Target[X]^.rgbBlue := ScanLine_Source[X]^.rgbBlue;
          ScanLine_Target[X]^.rgbGreen := ScanLine_Source[X]^.rgbGreen;
          ScanLine_Target[X]^.rgbRed:= ScanLine_Source[X]^.rgbRed;
          ScanLine_Target[X]^.rgbReserved:= ScanLine_Source[X]^.rgbReserved;
          }
        end;
    end;
end;

Wenn du also willst, dass ein Pixel von Bitmap1 in Bitmap2 X-und-Y-mal wiederholt wird, musst du - unter Berücksichtung der Bilddimensionen - die X-Schleife entsprechend anpassen und erweitern.

[TiGü]

Zitat:

Zitat von nuclearping (Beitrag 1253237)

Hat er doch schon oben, das Beispielbild.

Das zeigt mir aber nicht wie es jetzt ist und wie es sein soll! :roll:

Ob etwas pixelig wirkt hängt doch von der ursprünglichen Größe der Textur und der Ausgabe-Größe auf den Bildschirm zusammen?!

Ein 8 x 8 Pixel großes Bitmap auf ein Panel von 64 x 64 Pixel gezeichnet -> Pixelbrei!
Ein FullHD-Bild auf 400 x 300 -> scharf!

Ggf. in der DrawBitmap-Methode den InterpolationMode noch auf D2D1_BITMAP_INTERPOLATION_MODE_NEAREST_NEIGHBOR setzen.

[nuclearping]

Das "Vorher"-Bild ist auf der ersten Seite.

[Medium]

Den Filter auf Nearest Neighbor zu setzen sollte den gewünschten Effekt haben. Standardmäßig ist der imho auf bilineares Filtern eingestellt.

[TiGü]

Siehe zwei Posts zuvor.