1 {
2 *****************************************************************************
3 *                                                                           *
4 *  This file is part of the ZCAD                                            *
5 *                                                                           *
6 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
7 *  for details about the copyright.                                         *
8 *                                                                           *
9 *  This program is distributed in the hope that it will be useful,          *
10 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
11 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
12 *                                                                           *
13 *****************************************************************************
14 }
15 {
16 @author(Andrey Zubarev <zamtmn@yandex.ru>)
17 }
18 
19 unit uzglviewareadx;
20 {$INCLUDE def.inc}
21 interface
22 uses
23      Windows, Messages, LCLType, LCLProc, SysUtils, Variants,
24      Classes, Graphics, Controls, Forms, Dialogs,
25      Menus, ActnList, StdCtrls, ExtCtrls, ComCtrls,
26      uDxTypes, uD3Dcommon, uDXGI, uD3D11, uD3D11sdklayers,
27      uD3Dcompiler, uD3DX11,
28 
29      math,
30      uzgldrawerdx,
31      uzglbackendmanager,uzbgeomtypes,uzbtypes,uzglviewareaabstract,uzglviewareageneral,uzgldrawcontext,uzbtypesbase;
32 type
33   TVertexData = record
34     x: _FLOAT;
35     y: _FLOAT;
36     z: _FLOAT;
37     w: _FLOAT;
38     clr: D3DCOLORVALUE;
39   end;
40 const
41   input_layout: array [0..1] of D3D11_INPUT_ELEMENT_DESC =
42   (
43     (SemanticName: 'POSITION'; SemanticIndex: 0; Format: DXGI_FORMAT_R32G32B32A32_FLOAT;
44      InputSlot: 0; AlignedByteOffset: 0;
45      InputSlotClass: D3D11_INPUT_PER_VERTEX_DATA; InstanceDataStepRate: 0),
46     (SemanticName: 'COLOR'; SemanticIndex: 0; Format: DXGI_FORMAT_R32G32B32A32_FLOAT;
47      InputSlot: 0; AlignedByteOffset: 0 + (SizeOf(_FLOAT) * 4);
48      InputSlotClass: D3D11_INPUT_PER_VERTEX_DATA; InstanceDataStepRate: 0)
49   );
50 
51   vertices: array[0..2] of TVertexData =
52   (
53     (x:  0.00; y:  1.00; z: 0.0; w: 1.0; clr: (r: 0.75; g: 0.75; b: 0.25; a: 1.0)),
54     (x:  0.75; y: -1.00; z: 0.0; w: 1.0; clr: (r: 0.75; g: 0.25; b: 0.75; a: 1.0)),
55     (x: -0.75; y: -1.00; z: 0.0; w: 1.0; clr: (r: 0.25; g: 0.75; b: 0.75; a: 1.0))
56   );
57 
58   strides: UINT = SizeOf(vertices[Low(vertices)]);
59   offsets: UINT = 0;
60 
61 type
62     TRenderPanel = class(TCustomControl)
63       private
64         bInitComplete: Boolean;
65 
66         dtFrames: TDateTime;
67         nFrames: Int64;
68         nLastFPS: Double;
69 
70         dwTicksOfLastRender: UINT;
71 
72         nSelectedMsaa: UINT;
73 
74         pCompiledVertexShader: ID3DBlob;
75         pCompiledPixelShader: ID3DBlob;
76 
77         pDXGIfactory: IDXGIFactory;
78         pDXGIoutput: IDXGIOutput;
79 
80         pD3Ddevice: ID3D11Device;
81         pD3Dcontext: ID3D11DeviceContext;
82 
83         pD3Ddebug: ID3D11Debug;
84 
85         pSwapChain: IDXGISwapChain;
86         pRenderTargetView: ID3D11RenderTargetView;
87 
88         pRasterizerState: ID3D11RasterizerState;
89         pInputLayout: ID3D11InputLayout;
90         pVertexBuffer: ID3D11Buffer;
91         pConstantBuffer: ID3D11Buffer;
92         pVertexShader: ID3D11VertexShader;
93         pPixelShader: ID3D11PixelShader;
94       protected
95         procedure CreateParams(var params: TCreateParams);  override;
96         procedure WndProc(var msg: TMessage);  override;
97       public
98         constructor Create(AOwner: TComponent);  override;
99         destructor Destroy();  override;
100 
101         procedure InitShaders(const sCode: AnsiString; out pVS, pPS: ID3DBlob);
102         procedure InitDirect3D();
103         procedure FinalizeDirect3D();
104 
105         procedure ProcessShaderCompilationMessages(var pErrorMsgs: ID3DBlob; hr, hr2: HRESULT);
106         procedure SetDebugName(const pObject: ID3D11DeviceChild; const sName: AnsiString);
107 
108         procedure Resize();  override;
109         procedure Paint();  override;
110       end;
111     PTDXWnd = ^TDXWnd;
112     TDXWnd = class(TRenderPanel)
113     private
114     public
115       wa:TAbstractViewArea;
116       procedure EraseBackground(DC: HDC);{$IFNDEF DELPHI}override;{$ENDIF}
117     end;
118     TDX11ViewArea=class(TGeneralViewArea)
119                       public
120                       DXWindow:TDXWnd;
121                       OpenGLParam:TDXData;
CreateWorkAreanull122                       function CreateWorkArea(TheOwner: TComponent):TCADControl; override;
123                       procedure CreateDrawer; override;
124                       procedure SetupWorkArea; override;
125                       procedure WaResize(sender:tobject); override;
126 
127                       procedure SwapBuffers(var DC:TDrawContext); override;
128                       procedure getareacaps; override;
129                       procedure GDBActivateGLContext; override;
NeedDrawInsidePaintEventnull130                       function NeedDrawInsidePaintEvent:boolean; override;
131                       procedure setdeicevariable; override;
getParamnull132                       function getParam:pointer; override;
getParamTypeNamenull133                       function getParamTypeName:GDBString; override;
CreateRCnull134                       function CreateRC(_maxdetail:GDBBoolean=false):TDrawContext;override;
135                   end;
136 implementation
137 
138 type
139 TConstantBufferData = record
140   matView: D3DXMATRIX;
141   matProjection: D3DXMATRIX;
142   matWorld: D3DXMATRIX;
143   matResult: D3DXMATRIX;
144   dwTimeInterval: UINT;
145   dwGetTickCount: UINT;
146   dwUnused: array[2..15] of UINT;
147 end;
148 
149 constructor TRenderPanel.Create(AOwner: TComponent);
150 begin
151   inherited Create(AOwner);
152 
153   bInitComplete := FALSE;
154 
155   DoubleBuffered := FALSE;
156   ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csMenuEvents, csOpaque{, csOverrideStylePaint}];
157 
158   dtFrames := Now();
159   nFrames := 0;
160   nLastFPS := 0;
161 
162   dwTicksOfLastRender := GetTickCount();
163 
164   nSelectedMsaa := 1;
165 
166   pPixelShader := nil;
167   pVertexShader := nil;
168   pConstantBuffer := nil;
169   pVertexBuffer := nil;
170   pInputLayout := nil;
171   pRasterizerState := nil;
172   pRenderTargetView := nil;
173   pSwapChain := nil;
174   pD3Ddebug := nil;
175   pD3Dcontext := nil;
176   pD3Ddevice := nil;
177   pDXGIoutput := nil;
178   pDXGIfactory := nil;
179 end;
180 
181 destructor TRenderPanel.Destroy;
182 begin
183   FinalizeDirect3D();
184 
185   inherited Destroy();
186 end;
187 
188 procedure TRenderPanel.CreateParams(var params: TCreateParams);
189 begin
190   inherited CreateParams(params);
191 
192   params.WindowClass.style := params.WindowClass.style or CS_HREDRAW or CS_VREDRAW;
193   params.Style := params.Style or WS_CLIPSIBLINGS or WS_CLIPCHILDREN;
194 end;
195 
196 procedure TRenderPanel.WndProc(var msg: TMessage);
197 begin
198   if ( msg.Msg = WM_ERASEBKGND ) and ( bInitComplete ) then
199   begin
200     msg.Result := 1;
201     Exit;
202   end;
203 
204   inherited WndProc(msg);
205 end;
206 
207 procedure TRenderPanel.ProcessShaderCompilationMessages(var pErrorMsgs: ID3DBlob; hr, hr2: HRESULT);
208 var
209   nSize: SIZE_T;
210   pData: Pointer;
211   sData: AnsiString;
212 begin
213   if ( pErrorMsgs = nil ) then Exit;
214 
215   nSize := pErrorMsgs.GetBufferSize();
216   pData := pErrorMsgs.GetBufferPointer();
217 
218   if ( nSize = 0 ) then
219   begin
220     pErrorMsgs := nil;
221     Exit;
222   end;
223 
224   SetLength(sData, nSize);
225   CopyMemory(PAnsiChar(sData), pData, nSize);
226   pErrorMsgs := nil;
227 
228   //TFormMain(Owner).txtShaderErrors.Lines.Text := TFormMain(Owner).txtShaderErrors.Lines.Text + sLineBreak + string(sData);
229   //TFormMain(Owner).StatusBar.Panels[0].Text := 'Обнаружены ошибки при компиляции шейдера!';
230 end;
231 
232 procedure TRenderPanel.SetDebugName(const pObject: ID3D11DeviceChild; const sName: AnsiString);
233 begin
234   if ( pObject <> nil ) and ( Length(sName) > 0 ) then
235     pObject.SetPrivateData(WKPDID_D3DDebugObjectName, Length(sName), PAnsiChar(sName))
236 end;
237 
238 procedure TRenderPanel.InitShaders(const sCode: AnsiString; out pVS, pPS: ID3DBlob);
239 var
240   hr, hr2: HRESULT;
241   pErrorMsgs: ID3DBlob;
242 begin
243   pVS := nil;
244   pPS := nil;
245 
246   //TFormMain(Owner).txtShaderErrors.Lines.Text := '';
247 
248   if ( Length(sCode) = 0 ) then Exit;
249 
250   //TFormMain(Owner).StatusBar.Panels[0].Text := '';
251 
252   hr2 := S_OK;
253   hr := D3DX11CompileFromMemory
254         (
255           PAnsiChar(sCode), Length(sCode),
256           nil, nil, nil, 'VS', 'vs_4_0',
257           D3DCOMPILE_ENABLE_STRICTNESS or D3DCOMPILE_WARNINGS_ARE_ERRORS, 0,
258           nil, pVS, @pErrorMsgs, @hr2
259         );
260   ProcessShaderCompilationMessages(pErrorMsgs, hr, hr2);
261 
262   hr := D3DX11CompileFromMemory
263         (
264           PAnsiChar(sCode), Length(sCode),
265           nil, nil, nil, 'PS', 'ps_4_0',
266           D3DCOMPILE_ENABLE_STRICTNESS or D3DCOMPILE_WARNINGS_ARE_ERRORS, 0,
267           nil, pPS, @pErrorMsgs, @hr2
268         );
269   ProcessShaderCompilationMessages(pErrorMsgs, hr, hr2);
270 
271   //if ( pVS <> nil ) and ( pPS <> nil ) and
272   //   ( Length(TFormMain(Owner).StatusBar.Panels[0].Text) = 0 ) then
273   //  TFormMain(Owner).StatusBar.Panels[0].Text := 'Компиляция шейдеров выполнена успешно';
274 end;
275 
276 procedure TRenderPanel.InitDirect3D();
277 var
278   hr: HRESULT;
279   nQualityTest: UINT;
280   FeatureLevel: D3D11_FEATURE_LEVEL;
281   FeatureLevelRet: D3D11_FEATURE_LEVEL;
282   vpDesc: D3D11_VIEWPORT;
283   pBackBuffer: ID3D11Texture2D;
284   srData: D3D11_SUBRESOURCE_DATA;
285   cbBuf: TConstantBufferData;
286 begin
287   FinalizeDirect3D();
288 
289   hr := CreateDXGIFactory(IDXGIFactory, pDXGIfactory);
290   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
291 
292   FeatureLevel := D3D11_FEATURE_LEVEL(0);
293   FeatureLevelRet := D3D11_FEATURE_LEVEL(0);
294 
295   hr := D3D11CreateDevice
296         (
297           nil, D3D11_DRIVER_TYPE_HARDWARE, 0,
298           IfThen({TFormMain(Owner).actOtherDebugDevice.Checked}false, D3D11_CREATE_DEVICE_DEBUG, 0),
299           nil, 0, D3D11_SDK_VERSION,
300           nil, @FeatureLevel, nil
301         );
302   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
303 
304   hr := D3D11CreateDeviceAndSwapChain
305         (
306           nil, D3D11_DRIVER_TYPE_HARDWARE, 0,
307           IfThen({TFormMain(Owner).actOtherDebugDevice.Checked}false, D3D11_CREATE_DEVICE_DEBUG, 0),
308           @FeatureLevel, 1, D3D11_SDK_VERSION,
309           DXGI_SwapChainDesc
310           (
311             DXGI_ModeDesc
312             (
313               Self.ClientWidth, Self.ClientHeight,
314               DXGI_Rational_(60, 1),
315               DXGI_FORMAT_R8G8B8A8_UNORM,
316               DXGI_MODE_SCANLINE_ORDER_UNSPECIFIED,
317               DXGI_MODE_SCALING_UNSPECIFIED
318             ),
319             DXGI_SampleDesc(nSelectedMsaa, 0),
320             Self.Handle, TRUE, 1,
321             DXGI_USAGE_RENDER_TARGET_OUTPUT,
322             DXGI_SWAP_EFFECT_DISCARD,
323             0
324           ),
325           @pSwapChain, @pD3Ddevice, @FeatureLevelRet, @pD3Dcontext
326         );
327   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
328 
329   SetDebugName(pD3Dcontext, 'TFormMain.pD3Dcontext');
330 
331   if ( {TFormMain(Owner).actOtherDebugDevice.Checked}false ) then
332   begin
333     hr := pD3Ddevice.QueryInterface(ID3D11Debug, pD3Ddebug);
334     if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
335   end;
336 
337   hr := pSwapChain.GetContainingOutput(pDXGIoutput);
338   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
339 
340   hr := pDXGIfactory.MakeWindowAssociation(Self.Handle, DXGI_MWA_NO_WINDOW_CHANGES);
341   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
342 
343   hr := pSwapChain.GetBuffer(0, ID3D11Texture2D, pBackBuffer);
344   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
345 
346   SetDebugName(pBackBuffer, 'FormMain.pBackBuffer');
347 
348   hr := pD3DDevice.CreateRenderTargetView(pBackBuffer, nil, pRenderTargetView);
349   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
350 
351   SetDebugName(pRenderTargetView, 'FormMain.pRenderTargetView');
352 
353   pD3Dcontext.OMSetRenderTargets(1, @pRenderTargetView, nil);
354 
355   vpDesc.Width := Self.ClientWidth;
356   vpDesc.Height := Self.ClientHeight;
357   vpDesc.MinDepth := 0.0;
358   vpDesc.MaxDepth := 1.0;
359   vpDesc.TopLeftX := 0;
360   vpDesc.TopLeftY := 0;
361   pD3DContext.RSSetViewports(1, @vpDesc);
362 
363   hr := pD3Ddevice.CreateRasterizerState
364         (
365           D3D11_RasterizerDesc
366           (
367             D3D11_FILL_SOLID, D3D11_CULL_NONE,
368             FALSE, 0, 0, 0,
369             FALSE, FALSE, TRUE, TRUE
370           ),
371           pRasterizerState
372         );
373   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
374 
375   SetDebugName(pRasterizerState, 'FormMain.pRasterizerState');
376 
377   pD3Dcontext.RSSetState(pRasterizerState);
378 
379   ZeroMemory(@cbBuf, SizeOf(cbBuf));
380   cbBuf.dwTimeInterval := 0;
381   cbBuf.dwGetTickCount := GetTickCount();
382 
383   srData.pSysMem := @cbBuf;
384   srData.SysMemPitch := 0;
385   srData.SysMemSlicePitch := 0;
386 
387   hr := pD3Ddevice.CreateBuffer
388         (
389           D3D11_BufferDesc
390           (
391             SizeOf(cbBuf),
392             D3D11_BIND_CONSTANT_BUFFER,
393             D3D11_USAGE_DYNAMIC,
394             D3D11_CPU_ACCESS_WRITE,
395             0, 0
396           ),
397           @srData,
398           pConstantBuffer
399         );
400   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
401 
402   SetDebugName(pConstantBuffer, 'TFormMain.pConstantBuffer');
403 
404   hr := pD3DDevice.CreateVertexShader
405         (
406           pCompiledVertexShader.GetBufferPointer(),
407           pCompiledVertexShader.GetBufferSize(),
408           nil,
409           pVertexShader
410         );
411   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
412 
413   SetDebugName(pVertexShader, 'TFormMain.pVertexShader');
414 
415   hr := pD3Ddevice.CreatePixelShader
416         (
417           pCompiledPixelShader.GetBufferPointer(),
418           pCompiledPixelShader.GetBufferSize(),
419           nil,
420           pPixelShader
421         );
422   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
423 
424   SetDebugName(pPixelShader, 'TFormMain.pPixelShader');
425 
426   hr := pD3Ddevice.CreateInputLayout
427         (
428           @input_layout[Low(input_layout)], Length(input_layout),
429           pCompiledVertexShader.GetBufferPointer(),
430           pCompiledVertexShader.GetBufferSize(),
431           pInputLayout
432         );
433   if ( Failed(hr) ) then EOSError.Create(SysErrorMessage(hr));
434 
435   SetDebugName(pInputLayout, 'TFormMain.pInputLayout');
436 
437   srData.pSysMem := @vertices[Low(vertices)];
438   srData.SysMemPitch := 0;
439   srData.SysMemSlicePitch := 0;
440 
441   hr := pD3Ddevice.CreateBuffer
442         (
443           D3D11_BufferDesc
444           (
445             SizeOf(vertices[Low(vertices)]) * Length(vertices),
446             D3D11_BIND_VERTEX_BUFFER,
447             D3D11_USAGE_DEFAULT,
448             0, 0, 0
449           ),
450           @srData,
451           pVertexBuffer
452         );
453   if ( Failed(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
454 
455   SetDebugName(pVertexBuffer, 'TFormMain.pVertexBuffer');
456 
457   nQualityTest := 0;
458   hr := pD3Ddevice.CheckMultisampleQualityLevels(DXGI_FORMAT_R8G8B8A8_UNORM, 2, nQualityTest);
459   //TFormMain(Owner).actRenderMsaa2.Enabled := ( Succeeded(hr) ) and ( nQualityTest > 0 );
460 
461   nQualityTest := 0;
462   hr := pD3Ddevice.CheckMultisampleQualityLevels(DXGI_FORMAT_R8G8B8A8_UNORM, 4, nQualityTest);
463   //TFormMain(Owner).actRenderMsaa4.Enabled := ( Succeeded(hr) ) and ( nQualityTest > 0 );
464 
465   nQualityTest := 0;
466   hr := pD3Ddevice.CheckMultisampleQualityLevels(DXGI_FORMAT_R8G8B8A8_UNORM, 8, nQualityTest);
467   //TFormMain(Owner).actRenderMsaa8.Enabled := ( Succeeded(hr) ) and ( nQualityTest > 0 );
468 
469   bInitComplete := TRUE;
470 end;
471 
472 procedure TRenderPanel.FinalizeDirect3D();
473 begin
474   bInitComplete := FALSE;
475 
476   if ( pD3Dcontext <> nil ) then
477     pD3Dcontext.ClearState();
478 
479   pPixelShader := nil;
480   pVertexShader := nil;
481   pConstantBuffer := nil;
482   pVertexBuffer := nil;
483   pInputLayout := nil;
484   pRasterizerState := nil;
485   pRenderTargetView := nil;
486   pSwapChain := nil;
487   pD3Ddebug := nil;
488   pD3Dcontext := nil;
489   pD3Ddevice := nil;
490   pDXGIoutput := nil;
491   pDXGIfactory := nil;
492 end;
493 
494 procedure TRenderPanel.Resize();
495 var
496   hr: HRESULT;
497   swDesc: DXGI_SWAP_CHAIN_DESC;
498   vpDesc: D3D11_VIEWPORT;
499   pBackBuffer: ID3D11Texture2D;
500 begin
501   try
502     if ( not bInitComplete ) then Exit;
503 
504     bInitComplete := FALSE;
505 
506     pD3Dcontext.OMSetRenderTargets(0, nil, nil);
507     pRenderTargetView := nil;
508 
509     ZeroMemory(@swDesc, SizeOf(swDesc));
510     swDesc.BufferDesc.Format := DXGI_FORMAT_UNKNOWN;
511 
512     hr := pSwapChain.GetDesc(swDesc);
513     if ( FAILED(hr) ) then raise EOSError.Create(SysErrorMessage(hr));
514 
515     if ( nSelectedMsaa = swDesc.SampleDesc.Count ) then
516     begin
517       hr := pSwapChain.ResizeBuffers
518             (
519               1,
520               Self.ClientWidth, Self.ClientHeight,
521               swDesc.BufferDesc.Format, 0
522             );
523 
524       if ( Failed(hr) ) then
525       begin
526         //TFormMain(Owner).StatusBar.Panels[0].Text := 'ошибка метода pSwapChain.ResizeBuffers(): ' + QuotedStr(SysErrorMessage(hr));
527         Exit;
528       end;
529     end
530     else begin
531       pSwapChain := nil;
532 
533       hr := pDXGIfactory.CreateSwapChain
534             (
535               pD3DDevice,
536               DXGI_SwapChainDesc
537               (
538                 DXGI_ModeDesc
539                 (
540                   Self.ClientWidth, Self.ClientHeight,
541                   DXGI_Rational_(60, 1),
542                   DXGI_FORMAT_R8G8B8A8_UNORM,
543                   DXGI_MODE_SCANLINE_ORDER_UNSPECIFIED,
544                   DXGI_MODE_SCALING_UNSPECIFIED
545                 ),
546                 DXGI_SampleDesc(nSelectedMsaa, 0),
547                 Self.Handle, TRUE, 1,
548                 DXGI_USAGE_RENDER_TARGET_OUTPUT,
549                 DXGI_SWAP_EFFECT_DISCARD,
550                 0
551               ),
552               pSwapChain
553             );
554 
555       if ( Failed(hr) ) then
556       begin
557         //TFormMain(Owner).StatusBar.Panels[0].Text := 'pSwapChain.ResizeBuffers(): ' + QuotedStr(SysErrorMessage(hr));
558         Exit;
559       end;
560 
561       hr := pDXGIfactory.MakeWindowAssociation(Self.Handle, DXGI_MWA_NO_WINDOW_CHANGES);
562 
563       if ( Failed(hr) ) then
564         //TFormMain(Owner).StatusBar.Panels[0].Text := 'pDXGIfactory.MakeWindowAssociation(): ' + QuotedStr(SysErrorMessage(hr));
565     end;
566 
567     hr := pSwapChain.GetBuffer(0, ID3D11Texture2D, pBackBuffer);
568     if ( Failed(hr) ) then
569     begin
570       //TFormMain(Owner).StatusBar.Panels[0].Text := 'pSwapChain.GetBuffer(): ' + QuotedStr(SysErrorMessage(hr));
571       Exit;
572     end;
573 
574     hr := pD3Ddevice.CreateRenderTargetView(pBackBuffer, nil, pRenderTargetView);
575     if ( Failed(hr) ) then
576     begin
577       //TFormMain(Owner).StatusBar.Panels[0].Text := 'pD3DDevice.CreateRenderTargetView(): ' + QuotedStr(SysErrorMessage(hr));
578       Exit;
579     end;
580 
581     pD3Dcontext.OMSetRenderTargets(1, @pRenderTargetView, nil);
582 
583     vpDesc.Width := Self.ClientWidth;
584     vpDesc.Height := Self.ClientHeight;
585     vpDesc.MinDepth := 0.0;
586     vpDesc.MaxDepth := 1.0;
587     vpDesc.TopLeftX := 0;
588     vpDesc.TopLeftY := 0;
589 
590     pD3Dcontext.RSSetViewports(1, @vpDesc);
591 
592     bInitComplete := TRUE;
593 
594     InvalidateRect(Self.Handle, nil, FALSE);
595   finally
596     inherited Resize();
597   end;
598 end;
599 
600 procedure TRenderPanel.Paint();
601 var
602   hr: HRESULT;
603   cbBuf: TConstantBufferData;
604   dwMS: Int64;
605   sTextFPS: string;
606   msrData: D3D11_MAPPED_SUBRESOURCE;
607 begin
608   if ( not bInitComplete ) then
609   begin
610     inherited Paint();
611     Exit;
612   end;
613 
614   if {( TFormMain(Owner).actRenderVSync.Checked )}true then
615   begin
616     hr := pDXGIoutput.WaitForVBlank();
617 
618     //if ( Failed(hr) ) then
619     //  TFormMain(Owner).StatusBar.Panels[0].Text := 'pDXGIoutput.WaitForVBlank(): ' + QuotedSTr(SysErrorMessage(hr));
620   end;
621 
622   ZeroMemory(@cbBuf, SizeOf(cbBuf));
623 
624   {cbBuf.matView := MatrixLookToLH
625                    (
626                      D3D_Vector ( 0.0,  0.0, -5.0 ),
627                      D3D_Vector ( 0.0,  0.0,  5.0 ),
628                      D3D_Vector ( 0.0,  1.0,  0.0 )
629                    );
630   cbBuf.matProjection := MatrixPerspectiveFovLH
631                          (
632                            1.0, 0.65, 1.0, 100.0
633                          );
634   cbBuf.matWorld := D3D_Matrix_Identity();
635 
636   cbBuf.matResult := MatrixMultiply
637                      (
638                        cbBuf.matWorld,
639                        MatrixMultiply
640                        (
641                          cbBuf.matView,
642                          cbBuf.matProjection
643                        )
644                      );}
645 
646   cbBuf.matView := D3D_Matrix_Transpose(cbBuf.matView);
647   cbBuf.matProjection := D3D_Matrix_Transpose(cbBuf.matProjection);
648   cbBuf.matWorld := D3D_Matrix_Transpose(cbBuf.matWorld);
649   cbBuf.matResult := D3D_Matrix_Transpose(cbBuf.matResult);
650 
651   cbBuf.dwGetTickCount := GetTickCount();
652   cbBuf.dwTimeInterval := ( cbBuf.dwGetTickCount - dwTicksOfLastRender );
653 
654   dwTicksOfLastRender := cbBuf.dwGetTickCount;
655 
656   hr := pD3Dcontext.Map(pConstantBuffer, 0, D3D11_MAP_WRITE_DISCARD, 0, msrData);
657   if ( Succeeded(hr) ) then
658   try
659     CopyMemory(msrData.pData, @cbBuf, SizeOf(cbBuf));
660   finally
661     pD3Dcontext.Unmap(pConstantBuffer, 0);
662   end;
663 
664   //if ( Failed(hr) ) then
665   //  TFormMain(Owner).StatusBar.Panels[0].Text := 'pD3Dcontext.Map(): ' + QuotedStr(SysErrorMessage(hr));
666 
667   pD3Dcontext.ClearRenderTargetView(pRenderTargetView, D3D11_RGBA_FLOAT(0, 0, 0, 1.0));
668 
669     pD3Dcontext.RSSetState(pRasterizerState);
670     pD3Dcontext.IASetInputLayout(pInputLayout);
671     pD3Dcontext.IASetPrimitiveTopology(D3D11_PRIMITIVE_TOPOLOGY_TRIANGLELIST);
672     pD3Dcontext.IASetVertexBuffers(0, 1, @pVertexBuffer, @strides, @offsets);
673     pD3Dcontext.IASetIndexBuffer(nil, DXGI_FORMAT_UNKNOWN, 0);
674     pD3Dcontext.VSSetConstantBuffers(0, 1, @pConstantBuffer);
675     pD3Dcontext.VSSetShader(pVertexShader, nil, 0);
676     pD3Dcontext.PSSetConstantBuffers(0, 1, @pConstantBuffer);
677     pD3Dcontext.PSSetShader(pPixelShader, nil, 0);
678 
679     pD3Dcontext.Draw(3, 0);
680 
681   hr := pSwapChain.Present(0, 0);
682 
683   //if ( Failed(hr) ) then
684   //  TFormMain(Owner).StatusBar.Panels[0].Text := 'SwapChain.Present(): ' + QuotedStr(SysErrorMessage(hr));
685 
686   nFrames := nFrames + 1;
687 
688   {dwMS := abs(MilliSecondsBetween(dtFrames, Now()));
689   if ( dwMS >= 1000 ) then
690   begin
691     nLastFPS := ( nFrames * 1000.0 / dwMS );
692     dtFrames := Now();
693     nFrames := 0;
694 
695     if ( nLastFPS > 0 ) then
696     begin
697       if ( nLastFPS >= 20 )
698         then sTextFPS := IntToStr(Round(nLastFPS))
699         else sTextFPS := FormatFloat('0.0#', nLastFPS);
700 
701       sTextFPS := sTextFPS + ' fps';
702     end
703     else
704       sTextFPS := '- fps';
705 
706     TFormMain(Owner).StatusBar.Panels[1].Text := sTextFPS;
707   end;}
708 end;
709 
710 
711 
712 
TDX11ViewArea.CreateRCnull713 function TDX11ViewArea.CreateRC(_maxdetail:GDBBoolean=false):TDrawContext;
714 begin
715   result:=inherited CreateRC(_maxdetail);
716   result.MaxWidth:={OpenGLParam.RD_MaxWidth}100;
717 end;
718 procedure TDXWnd.EraseBackground(DC: HDC);
719 begin
720 end;
TDX11ViewArea.getParamnull721 function TDX11ViewArea.getParam;
722 begin
723      result:=@OpenGLParam;
724 end;
725 
getParamTypeNamenull726 function TDX11ViewArea.getParamTypeName;
727 begin
728      result:='PTDXData';
729 end;
730 procedure TDX11ViewArea.GDBActivateGLContext;
731 begin
732    drawer.delmyscrbuf;
733 end;
NeedDrawInsidePaintEventnull734 function TDX11ViewArea.NeedDrawInsidePaintEvent:boolean;
735 begin
736      result:=false;
737 end;
738 
739 procedure TDX11ViewArea.setdeicevariable;
740 var tarray:array [0..1] of Double;
741     p:pansichar;
742 begin(*
743   //programlog.logoutstr('TOGLWnd.SetDeiceVariable',lp_IncPos,LM_Debug);
744   debugln('{D+}TOGLWnd.SetDeiceVariable');
745   oglsm.myglGetDoublev(GL_LINE_WIDTH_RANGE,@tarray[0]);
746   //if assigned(sysvar.RD.RD_MaxLineWidth) then   m,.
747   OpenGLParam.RD_MaxLineWidth:=tarray[1];
748   oglsm.myglGetDoublev(GL_point_size_RANGE,@tarray[0]);
749   //if assigned(sysvar.RD.RD_MaxPointSize) then
750   OpenGLParam.RD_MaxPointSize:=tarray[1];
751   GDBPointer(p):=oglsm.myglGetString(GL_VENDOR);
752   debugln('{I}RD_Vendor:="%s"',[p]);
753   //programlog.LogOutFormatStr('RD_Vendor:="%s"',[p],0,LM_Info);
754   //if assigned(OpenglParam.RD_Vendor) then
755   OpenglParam.RD_Vendor:=p;
756   GDBPointer(p):=oglsm.myglGetString(GL_RENDERER);
757   debugln('{I}RD_Renderer:="%s"',[p]);
758   //programlog.LogOutFormatStr('RD_Renderer:="%s"',[p],0,LM_Info);
759   //if assigned(OpenglParam.RD_Renderer) then
760   OpenglParam.RD_Renderer:=p;
761   GDBPointer(p):=oglsm.myglGetString(GL_VERSION);
762   debugln('{I}RD_Version:="%s"',[p]);
763   //programlog.LogOutFormatStr('RD_Version:="%s"',[p],0,LM_Info);
764   //if assigned(OpenglParam.RD_Version) then
765   OpenglParam.RD_Version:=p;
766 
767   GDBPointer(p):=oglsm.myglGetString(GL_EXTENSIONS);
768   debugln('{I}RD_Extensions:="%s"',[p]);
769   //programlog.LogOutFormatStr('RD_Extensions:="%s"',[p],0,LM_Info);
770   //if assigned(OpenglParam.RD_Extensions) then
771   OpenglParam.RD_Extensions:=p;
772   //if assigned(sysvar.RD.RD_MaxWidth) and assigned(sysvar.RD.RD_MaxLineWidth) then
773   begin
774   OpenGLParam.RD_MaxWidth:=round(min(OpenGLParam.RD_MaxPointSize,OpenGLParam.RD_MaxLineWidth));
775   debugln('{I}RD_MaxWidth:="%G"',[min(OpenGLParam.RD_MaxPointSize,OpenGLParam.RD_MaxLineWidth)]);
776   //programlog.LogOutFormatStr('RD_MaxWidth:="%G"',[min(sysvar.RD.RD_MaxPointSize^,sysvar.RD.RD_MaxLineWidth^)],0,LM_Info);
777   end;
778   //programlog.logoutstr('end;',lp_DecPos,LM_Debug);
779   debugln('{D-}TOGLWnd.SetDeiceVariable');*)
780 end;
781 
782 procedure TDX11ViewArea.getareacaps;
783 begin
784   if VerboseLog^ then
785     debugln('{D+}TDX11ViewArea.getareacaps');
786   setdeicevariable;
787   if VerboseLog^ then
788     debugln('{D-}end;{TDX11ViewArea.getareacaps}');
789 end;
790 
791 procedure TDX11ViewArea.SwapBuffers(var DC:TDrawContext);
792 begin
793      inherited;
794      //DXWindow.SwapBuffers;
795 end;
CreateWorkAreanull796 function TDX11ViewArea.CreateWorkArea(TheOwner: TComponent):TCADControl;
797 begin
798      result:=TCADControl(TDXWnd.Create(TheOwner));
799 end;
800 procedure TDX11ViewArea.CreateDrawer;
801 begin
802      drawer:=TZGLDXDrawer.Create;
803 end;
804 procedure TDX11ViewArea.SetupWorkArea;
805 begin
806      DXWindow:=TDXWnd(WorkArea);
807      DXWindow.wa:=self;
808      RemoveCursorIfNeed(DXWindow,sysvarRDRemoveSystemCursorFromWorkArea);
809      DXWindow.ShowHint:=true;
810      //fillchar(myscrbuf,sizeof(tmyscrbuf),0);
811 
812      //DXWindow.AuxBuffers:=0;
813      //DXWindow.StencilBits:=8;
814      //DXWindow.ColorBits:=24;
815      //DXWindow.DepthBits:=24;
816      DXWindow.onpaint:=mypaint;
817 end;
818 procedure TDX11ViewArea.WaResize(sender:tobject);
819 begin
820      inherited;
821      param.lastonmouseobject:=nil;
822      calcoptimalmatrix;
823      calcgrid;
824      param.firstdraw := true;
825      getviewcontrol.Invalidate;
826 end;
827 begin
828   RegisterBackend(TDX11ViewArea,'DirectX11');
829 end.
830