Delphi-PRAXiS - Header Übersetzung DirectX 11.1 und Direct2D 1.1

Gute Arbeit, auf dem ersten Blick scheinen die meisten Sachen zu funktionieren.
Jedoch muss man bei ID2D1DeviceContext.SetTarget unnötig casten.

Willst du noch die Sachen aus DXGI 1.2 und 1.3 sowie D2D 1.2 übersetzen?
Das MSDN rät ja von der Verwendung der Methode IDXGIFactory.CreateSwapChain ab und empfiehlt IDXGIFactory2::CreateSwapChainForHwnd.

Für alle die einen schnellen Einsteig mit diesen Headern wollen, TLinePainter malt einen dicken roten Strich auf schwarzen Hintergrund:

Delphi-Quellcode:

			unit DirectXBase;

interface

uses

  Winapi.Windows,

  System.SysUtils,

  System.Types,

  D3D11,

  D3D11_1,

  D3DX11,

  D3DCommon,

  D2D1,

  D2D1_1,

  D2DBaseType,

  DirectWrite,

  DXGI,

  DXGITypes;

type

  TDirectXBase = class(TObject)

  private

    function CreateD3DResources : Boolean;

    function CreateDXGIResources : Boolean;

    function CreateD2DResources : Boolean;

    function CreateD2DFactory : Boolean;

    function CreateDWriteFactory : Boolean;

    function CreateTargetBitmap : Boolean;

  protected

    FWindowHandle : HWND;

    FColorFormat : D2D1.TD2D1_PixelFormat;

    FDesktopDpi : System.Types.TPointF;

    FDWriteFactory : DirectWrite.IDWriteFactory;

    FD3DDevice1 : D3D11_1.ID3D11Device1;

    FD3DDeviceContext1 : D3D11_1.ID3D11DeviceContext1;

    FDXGIDevice1 : DXGI.IDXGIDevice1;

    FSwapChain : DXGI.IDXGISwapChain;

    FD2DFactory1 : D2D1_1.ID2D1Factory1;

    FD2DDevice : D2D1_1.ID2D1Device;

    FD2DContext : D2D1_1.ID2D1DeviceContext;

    FTargetBitmap : D2D1_1.ID2D1Bitmap1;

    FSolidColorBrush : D2D1.ID2D1SolidColorBrush;

    function CreateDeviceIndependentResources : Boolean; virtual;

    function CreateDeviceResources : Boolean; virtual;

    procedure Paint(X : Integer = 0; Y : Integer = 0); virtual;

    function Present : Boolean; virtual;

  public

    constructor Create(const AWindowHandle : HWND);

    function Render(X : Integer = 0; Y : Integer = 0) : Boolean; virtual;

    function Resize : Boolean; virtual;

  end;

  TLinePainter = class(TDirectXBase)

  private

    FLastD2DPoint : TD2D1_Point2F;

  protected

    procedure Paint(X : Integer = 0; Y : Integer = 0); override;

  end;

implementation

uses

  Vcl.Graphics;

function TDirectXBase.CreateDXGIResources : Boolean;

var

  LDXGIAdapter : IDXGIAdapter;

  LDXGIFactory : IDXGIFactory1;

  function GetSwapChainDescriptor : DXGI_SWAP_CHAIN_DESC;

  begin

    FillChar(Result, SizeOf(Result), 0);

    Result.BufferDesc.Format := FColorFormat.Format;

    Result.SampleDesc.Count := 1;

    Result.SampleDesc.Quality := 0;

    Result.BufferUsage := DXGI_USAGE_RENDER_TARGET_OUTPUT;

    Result.BufferCount := 2;

    Result.OutputWindow := FWindowHandle;

    Result.Windowed := True;

    Result.SwapEffect := DXGI_SWAP_EFFECT.DXGI_SWAP_EFFECT_DISCARD;

  end;

begin

  Result := Supports(FD3DDevice1, IDXGIDevice1, FDXGIDevice1);

  Result := Result and Succeeded(FDXGIDevice1.GetAdapter(LDXGIAdapter));

  Result := Result and Succeeded(LDXGIAdapter.GetParent(IDXGIFactory1, LDXGIFactory));

  Result := Result and Succeeded(LDXGIFactory.CreateSwapChain(FD3DDevice1, GetSwapChainDescriptor, FSwapChain));

  Result := Result and Succeeded(FDXGIDevice1.SetMaximumFrameLatency(1));

end;

constructor TDirectXBase.Create(const AWindowHandle : HWND);

begin

  FWindowHandle := AWindowHandle;

  FColorFormat.Format := DXGI_FORMAT_B8G8R8A8_UNORM;

  FColorFormat.AlphaMode := D2D1_ALPHA_MODE_PREMULTIPLIED;

  CreateDeviceIndependentResources;

  CreateDeviceResources;

end;

function TDirectXBase.CreateTargetBitmap : Boolean;

var

  LBitmapProps : TD2D1_BITMAP_PROPERTIES1;

  LSurface : IDXGISurface1;

begin

  Result := Succeeded(FSwapChain.GetBuffer(0, IDXGISurface1, LSurface));

  LBitmapProps.PixelFormat := FColorFormat;

  LBitmapProps.DpiX := FDesktopDpi.X;

  LBitmapProps.DpiY := FDesktopDpi.Y;

  LBitmapProps.bitmapOptions := TD2D1_BITMAP_OPTIONS(Ord(D2D1_BITMAP_OPTIONS_TARGET) or Ord(D2D1_BITMAP_OPTIONS_CANNOT_DRAW));

  Result := Result and Succeeded(FD2DContext.CreateBitmapFromDxgiSurface(LSurface, @LBitmapProps, FTargetBitmap));

  FD2DContext.SetTarget(ID2D1Image(FTargetBitmap)); //der Cast sollte eigentlich unnötig sein!

end;

function TDirectXBase.Render(X : Integer = 0; Y : Integer = 0): Boolean;

var

  HR : HRESULT;

begin

  if not Assigned(FTargetBitmap) then

  begin

    CreateTargetBitmap;

  end;

  FD2DContext.BeginDraw;

    Paint(X,Y);

  HR := FD2DContext.EndDraw();

  case HR of

    D2DERR_RECREATE_TARGET : HR := S_OK;

  end;

  Result := Succeeded(HR) and Present;

end;

function TDirectXBase.Resize: Boolean;

begin

  FD2DContext.SetTarget(nil);

  FTargetBitmap := nil;

  Result := Succeeded(FSwapChain.ResizeBuffers(0, 0, 0, DXGI_FORMAT_UNKNOWN, 0));

  Result := Result and Render;

end;

function TDirectXBase.Present : Boolean;

begin

  Result := Succeeded(FSwapChain.Present(1, 0));

end;

type

  TD2D_RECT_F_Helper = record helper for D2D_RECT_F

    function Convert(const AValue: TRect): D2D_RECT_F;

  end;

  function TD2D_RECT_F_Helper.Convert(const AValue: TRect): D2D_RECT_F;

  begin

    Self.top := AValue.Top;

    Self.left := AValue.Left;

    Self.bottom := AValue.Bottom;

    Self.right := AValue.Right;

  end;

procedure TDirectXBase.Paint(X : Integer = 0; Y : Integer = 0);

var

  LRect : TRect;

  LD2DRect : D2D_RECT_F;

begin

  if GetClientRect(FWindowHandle, LRect) then

  begin

    if (X = 0) and (Y = 0) then

    begin

      FD2DContext.Clear(D2D1ColorF(clBlack));

      LRect.Inflate(-10, -10);

      LD2DRect.Convert(LRect);

      FD2DContext.DrawRectangle(LD2DRect, FSolidColorBrush, 25.0);

      LRect.Inflate(-15, -15);

      LD2DRect.Convert(LRect);

      FSolidColorBrush.SetColor(D2D1ColorF(clFuchsia, 0.90));

      FD2DContext.DrawRectangle(LD2DRect, FSolidColorBrush, 20.0);

      LRect.Inflate(-20, -20);

      LD2DRect.Convert(LRect);

      FSolidColorBrush.SetColor(D2D1ColorF(clAqua, 0.85));

      FD2DContext.DrawRectangle(LD2DRect, FSolidColorBrush, 15.0);

    end;

  end;

end;

function TDirectXBase.CreateD2DFactory : Boolean;

var

  LFactoryOptions : TD2D1_FactoryOptions;

begin

  LFactoryOptions.DebugLevel := TD2D1_DebugLevel.D2D1_DEBUG_LEVEL_INFORMATION;

  Result := Succeeded(D2D1CreateFactory(D2D1_FACTORY_TYPE_SINGLE_THREADED, D2D1_1.ID2D1Factory1, @LFactoryOptions, FD2DFactory1));

end;

function TDirectXBase.CreateD2DResources : Boolean;

begin

  FD2DFactory1.GetDesktopDpi(FDesktopDpi.X, FDesktopDpi.Y);

  Result := Succeeded(FD2DFactory1.CreateDevice(FDXGIDevice1, FD2DDevice));

  Result := Result and Succeeded(FD2DDevice.CreateDeviceContext(D2D1_DEVICE_CONTEXT_OPTIONS_ENABLE_MULTITHREADED_OPTIMIZATIONS, FD2DContext));

  FD2DContext.CreateSolidColorBrush(D2D1ColorF(clRed, 0.95), nil, FSolidColorBrush);

end;

function TDirectXBase.CreateD3DResources : Boolean;

var

  LD3DDevice : ID3D11Device;

  LCreationFlags : Cardinal;

  LD3DDeviceContext : ID3D11DeviceContext;

  LDriver : D3D_DRIVER_TYPE;

const

  FeatureLevels : array [0 .. 6] of D3D_FEATURE_LEVEL = (

    D3D_FEATURE_LEVEL_11_1,

    D3D_FEATURE_LEVEL_11_0,

    D3D_FEATURE_LEVEL_10_1,

    D3D_FEATURE_LEVEL_10_0,

    D3D_FEATURE_LEVEL_9_3,

    D3D_FEATURE_LEVEL_9_2,

    D3D_FEATURE_LEVEL_9_1);

  DriverTypes : set of D3D_DRIVER_TYPE = [D3D_DRIVER_TYPE_HARDWARE, D3D_DRIVER_TYPE_WARP];

begin

  Result := False;

  LCreationFlags := LongWord(D3D11_CREATE_DEVICE_BGRA_SUPPORT);

  {$IFDEF DEBUG}

  LCreationFlags := LCreationFlags or LongWord(D3D11_CREATE_DEVICE_DEBUG);

  {$ENDIF}

  for LDriver in DriverTypes do

  begin

    Result := Succeeded(D3D11CreateDevice(nil, LDriver, 0, LCreationFlags, @FeatureLevels, Length(FeatureLevels), D3D11_SDK_VERSION, LD3DDevice, nil, LD3DDeviceContext));

    if Result then

      Break;

  end;

  Result := Result and Supports(LD3DDevice, ID3D11Device1, FD3DDevice1);

  Result := Result and Supports(LD3DDeviceContext, ID3D11DeviceContext1, FD3DDeviceContext1);

end;

function TDirectXBase.CreateDeviceIndependentResources : Boolean;

begin

  Result := CreateD2DFactory;

  Result := Result and CreateDWriteFactory;

end;

function TDirectXBase.CreateDeviceResources : Boolean;

begin

  Result := CreateD3DResources;

  Result := Result and CreateDXGIResources;

  Result := Result and CreateD2DResources;

end;

function TDirectXBase.CreateDWriteFactory : Boolean;

begin

  Result := Succeeded(DWriteCreateFactory(DWRITE_FACTORY_TYPE_SHARED, IDWriteFactory, FDWriteFactory))

end;

{ TLinePainter }

procedure TLinePainter.Paint(X, Y: Integer);

var

  LD2DPoint : TD2D1_Point2F;

begin

  LD2DPoint.X := X;

  LD2DPoint.Y := Y;

  FD2DContext.DrawLine(FLastD2DPoint, LD2DPoint, FSolidColorBrush, 5.0);

  FLastD2DPoint := LD2DPoint;

end;

end.

Mit einen kleinen Formular:

Delphi-Quellcode:

			unit DXTestFrm;

interface

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,

  Vcl.StdCtrls,

  DirectXBase;

type

  TForm1 = class(TForm)

    procedure FormDestroy(Sender: TObject);

    procedure FormCreate(Sender : TObject);

    procedure FormResize(Sender: TObject);

    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

  private

    FMyDirectX : TDirectXBase;

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

  FMyDirectX := TLinePainter.Create(Self.Handle);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

  FMyDirectX.Free;

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

  if ssLeft in Shift then

  begin

    FMyDirectX.Render(X,Y);

  end;

end;

procedure TForm1.FormResize(Sender: TObject);

begin

  FMyDirectX.Resize;

end;

end.