Création d'un jeu en 3D avec Delphi et FireMonkey

FMX.Types.GlobalUseGPUCanvas:= True;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
program FMXPong;

uses
  System.StartUpCopy,
  FMX.Forms,
  FMX.Types,

{$IFDEF MSWINDOWS}
  System.Math,
  Winapi.Windows,
  Winapi.D3D11,
  Winapi.D3DCommon,
  FMX.Context.DX11,
{$ENDIF}

  principale in 'principale.pas' {fPrincipale};

var
  PrevFPUState: TArithmeticExceptionMask;

{$R *.res}

{$IFDEF MSWINDOWS}

// *****************************************************************************
// Copiée de la fonction du même nom dans FMX.Context.DX11. ***

procedure SaveClearFPUState; inline;
begin
  PrevFPUState:= GetExceptionMask;
  SetExceptionMask(exAllArithmeticExceptions);
end;

// *****************************************************************************
// Copiée de la fonction du même nom dans FMX.Context.DX11. ***

procedure RestoreFPUState; inline;
begin
  SetExceptionMask(PrevFPUState);
end;

// *****************************************************************************

procedure TryUseWARPCanvas;
const
  FeatureLevels : array [0 .. 8] of D3D_FEATURE_LEVEL = (
    D3D_FEATURE_LEVEL_12_1,
    D3D_FEATURE_LEVEL_12_0,
    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
  );

var
  DX11Library : THandle;
  vResultHardware, vResultWarp: Integer;
  // Variables output de la fonction D3D11CreateDevice. ***
  TestDevice : ID3D11Device;
  LD3DDeviceContext : ID3D11DeviceContext;
  vFeatureLevelHardware, vFeatureLevelWarp: D3D_FEATURE_LEVEL;

begin
  // J'essaye de charger la dll de directX 11. ***
  DX11Library := LoadLibrary(winapi.D3D11.D3D11dll);
  if DX11Library <> 0 then
  begin
    try
      SaveClearFPUState; // copié de la fonction du même nom dans FMX.Context.DX11. ***
      try
        // Est-ce que la procédure "D3D11CreateDevice" est dispo dans la Dll ? ***
        if GetProcAddress(DX11Library, 'D3D11CreateDevice') <> nil then
        begin
          // Test sur le hardware. ***
          vResultHardware := D3D11CreateDevice(
            nil,
            D3D_DRIVER_TYPE_HARDWARE,
            0,
            D3D11_CREATE_DEVICE_BGRA_SUPPORT,
            @FeatureLevels,
            Length(FeatureLevels),
            D3D11_SDK_VERSION,
            TestDevice,
            vFeatureLevelHardware,
            LD3DDeviceContext
          );
          if (Succeeded(vResultHardware)) and (vFeatureLevelHardware < D3D_FEATURE_LEVEL_11_0) then
          begin
            // Test du "high-performance software rasterizer" (cf. msdn "D3D_DRIVER_TYPE enumeration"). ***
            vResultWarp := D3D11CreateDevice(
              nil,
              D3D_DRIVER_TYPE_WARP,
              0,
              D3D11_CREATE_DEVICE_BGRA_SUPPORT,
              @FeatureLevels,
              Length(FeatureLevels),
              D3D11_SDK_VERSION,
              TestDevice,
              vFeatureLevelWarp,
              LD3DDeviceContext
            );
            // Je regarde sur la FeatureLevel est plus élevée en Warp. ***
            if Succeeded(vResultWarp) and (vFeatureLevelWarp >= D3D_FEATURE_LEVEL_11_0) then
            begin
              // C'est le cas, je force le flag "GlobalUseDXSoftware". ***
              GlobalUseDXSoftware := True ;
            end;
          end;
        end;
      finally
        TestDevice := nil;
        RestoreFPUState; // copié de la fonction du même nom dans FMX.Context.DX11. ***
      end;
    finally
      FreeLibrary(DX11Library);
    end;
  end;
end;

// *****************************************************************************

{$ENDIF}

begin

{$IFDEF MSWINDOWS}
  TryUseWARPCanvas;
{$ENDIF}

  Application.Initialize;
  Application.CreateForm(TfPrincipale, fPrincipale);
  Application.Run;
end.