Header Übersetzung DirectX 11.1 und Direct2D 1.1

[SonnyBoyPro]

Hallo zusammen,

anbei meine aktuelle Übersetzung der DirectX 11.1 und Direct2D 1.1 Header.
Die JSB Header hab ich umbenannt und sind der vollständigkeithalber dabei.
Lassen sich auch unter FPC / Lazerus einsetzen.

Happy coding!

PS: für Rückmeldungen bin ich natürlich dankbar.

[TiGü]

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.

[SonnyBoyPro]

Hallo TiGü,

anbei die Header-Übersetzungen für DXGI 1.2, DXGI 1.3, Direct3 D11.2 und D2D 1.2
Diese lassen sich compilieren, aber nicht getestet ob funktionstauglich. Hab hier auch nur Win7 mit SP Update und leider kein Win8.1


bg

[SonnyBoyPro]

zum Type-Cast:
laut MSDN

Code:

void SetTarget(
  [in, optional]  ID2D1Image *target
);

allerdings "The ID2D1Image interface inherits from ID2D1Resource but does not have additional members."

wird die Deklaration daher auf

Delphi-Quellcode:

procedure SetTarget(image: ID2D1Resource); stdcall; // { MSDN: ID2D1Image is abstract class inherited from ID2D1Resource }
procedure GetTarget(image: ID2D1Resource); stdcall; // { MSDN: ID2D1Image is abstract class inherited from ID2D1Resource }

geändert, funktioniert Dein Demo-Programm auch ohne dem Type-Cast.

was jetzt sinnvoller oder besser ist kann ich leider nicht beurteilen

bg

[TiGü]

Zitat von SonnyBoyPro:

Hab hier auch nur Win7 mit SP Update und leider kein Win8.1

Aber mit den Service Pack kannst du doch zumindest bis DXGI 1.2 testen?
Ich guck gleich mal in meiner Win7-VM.

[SonnyBoyPro]

ich hab mal in meinem aktuellen projekt das probiert

Delphi-Quellcode:

{ working with D3D11.1 }
Result := FD3D11Device.QueryInterface(ID3D11Device1, FD3D11Device1);
    if (FAILED(Result)) then
        Exit;

    Result := FDeviceContext.QueryInterface(ID3D11DeviceContext1, FD3DContext1);
    if (FAILED(Result)) then
        Exit;

    { try some new stuff }
      Result := FD3D11Device.QueryInterface(IDXGIDevice2, pDXGIDevice);
      Result := pDXGIDevice.GetParent(IDXGIAdapter, pDXGIAdapter);
      pDXGIAdapter.GetParent(IDXGIFactory1, pIDXGIFactory);

damit hab ich für die pIDXGIFactory zumindest mal einen gültigen Zeiger bekommen. Ansonsten fehlt mir momentan der Anwendungsfall


und bei Deinem Bsp zu ändern auf

Delphi-Quellcode:

 Result := Result and Succeeded(FDXGIDevice1.GetAdapter(LDXGIAdapter));
  Result := Result and Succeeded(LDXGIAdapter.GetParent(IDXGIFactory2, LDXGIFactory2));
  Result := Result and Succeeded(LDXGIFactory2.CreateSwapChain(FD3DDevice1, GetSwapChainDescriptor, FSwapChain));
  Result := Result and Succeeded(FDXGIDevice1.SetMaximumFrameLatency(1));

geht.

[sx2008]

Gibt es von Microsoft eigentlich keine TLB-Dateien (oder TLB-Resourcen eingebettet in den DLLs) die alle Deklarationen enthalten?
Dann könnte man die Header bequem in Delphi importieren...

[TiGü]

Zitat von SonnyBoyPro:

damit hab ich für die pIDXGIFactory zumindest mal einen gültigen Zeiger bekommen. Ansonsten fehlt mir momentan der Anwendungsfall

DXGI 1.2 geht in meiner VM (siehe Anhang).

Jedoch muss ich explizit in der VM den DriverType auf WARP setzen, weil der Versuch eines Hardware Drivers eine Floating Point Exception im 64-Bit Build auslöst.
Unter 32-Bit in der VM kann er sogar einen Hardware-Driver Device erstellen?!

Der Anwendungsfall wäre halt nur IDXGIFactory2::CreateSwapChainForHwnd().

[TiGü]

Zitat von sx2008:

Gibt es von Microsoft eigentlich keine TLB-Dateien (oder TLB-Resourcen eingebettet in den DLLs) die alle Deklarationen enthalten?
Dann könnte man die Header bequem in Delphi importieren...

Nein, gibt es nicht!
Weder Google noch RAD Studio -> Component -> Import Component bieten mir was passendes an.

[TiGü]

Zitat von SonnyBoyPro:

was jetzt sinnvoller oder besser ist kann ich leider nicht beurteilen

Ich bin ja auch nur interessierter Laie, aber so stimmt die Vererbungslinie einfach nicht.
Siehe auch den anderen Thread, wo wir das schon mal diskutiert hatten.