Bitmap erstellen und mit Direct2D zeichnen

[TiGü]

Zitat von 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...

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.