{******************************************************************************}
{* Иллюстрация к книге "DirectX. Графика в проектах Delphi".                  *}
{* Издательство BHV. www.bhv.ru                                               *}
{* Краснов М.В. softgl@chat.ru                                                *}
{******************************************************************************}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AppEvnts,
  DirectXGraphics, DXGUtils;

type
  TfrmD3D = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ApplicationEvents1Restore(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FD3D            : IDIRECT3D8;
    FD3DDevice      : IDIRECT3DDEVICE8;
    FD3DVB          : IDIRECT3DVERTEXBUFFER8;
    FActive         : BOOL;
    ThisTickCount   : DWORD;
    LastTickCount   : DWORD;
    function Render : HRESULT;
    function InitD3D : HRESULT;
    function InitVB : HRESULT;
    function Pentagon(const a, b, c, d, e : Integer) : HRESULT;
    procedure InitDodecahedron;
    procedure Dodecahedron;
    procedure DrawScene;
    procedure Cleanup;
    procedure ErrorOut (const Caption : PChar; const hError : HRESULT);
  public
    { Public declarations }
  end;

type
  TCUSTOMVERTEX = packed record
    X, Y, Z : Single;
  end;

const
  D3DFVF_CUSTOMVERTEX = D3DFVF_XYZ;

var
  frmD3D: TfrmD3D;
  Frames : Integer = 0;

  Angle : Single = 0.0;

implementation

{$R *.DFM}

var
  dodec : Array [0..19, 0..2] of Single;

procedure TfrmD3D.InitDodecahedron;
var
  alpha, beta : Single;
begin
  alpha := sqrt(2.0 / (3.0 + sqrt(5.0)));
  beta := 1.0 + sqrt(6.0 / (3.0 + sqrt(5.0)) -
    2.0 + 2.0 * sqrt(2.0 / (3.0 + sqrt(5.0))));

  dodec[0, 0] := -alpha;  dodec[0, 1] := 0;       dodec[0, 2] := beta;
  dodec[1, 0] := alpha;   dodec[1, 1] := 0;       dodec[1, 2] := beta;
  dodec[2, 0] := -1;      dodec[2, 1] := -1;      dodec[2, 2] := -1;
  dodec[3, 0] := -1;      dodec[3, 1] := -1;      dodec[3, 2] := 1;
  dodec[4, 0] := -1;      dodec[4, 1] := 1;       dodec[4, 2] := -1;
  dodec[5, 0] := -1;      dodec[5, 1] := 1;       dodec[5, 2] := 1;
  dodec[6, 0] := 1;       dodec[6, 1] := -1;      dodec[6, 2] := -1;
  dodec[7, 0] := 1;       dodec[7, 1] := -1;      dodec[7, 2] := 1;
  dodec[8, 0] := 1;       dodec[8, 1] := 1;       dodec[8, 2] := -1;
  dodec[9, 0] := 1;       dodec[9, 1] := 1;       dodec[9, 2] := 1;
  dodec[10, 0] := beta;   dodec[10, 1] := alpha;  dodec[10, 2] := 0;
  dodec[11, 0] := beta;   dodec[11, 1] := -alpha; dodec[11, 2] := 0;
  dodec[12, 0] := -beta;  dodec[12, 1] := alpha;  dodec[12, 2] := 0;
  dodec[13, 0] := -beta;  dodec[13, 1] := -alpha; dodec[13, 2] := 0;
  dodec[14, 0] := -alpha; dodec[14, 1] := 0;      dodec[14, 2] := -beta;
  dodec[15, 0] := alpha;  dodec[15, 1] := 0;      dodec[15, 2] := -beta;
  dodec[16, 0] := 0;      dodec[16, 1] := beta;   dodec[16, 2] := alpha;
  dodec[17, 0] := 0;      dodec[17, 1] := beta;   dodec[17, 2] := -alpha;
  dodec[18, 0] := 0;      dodec[18, 1] := -beta;  dodec[18, 2] := alpha;
  dodec[19, 0] := 0;      dodec[19, 1] := -beta;  dodec[19, 2] := -alpha;
end;

procedure TfrmD3D.Cleanup;
begin
  if Assigned (FD3DVB) then begin
     FD3DVB._Release;
     FD3DVB := nil;
  end;

  if Assigned (FD3DDevice) then begin
     FD3DDevice._Release;
     FD3DDevice := nil;
  end;

  if Assigned (FD3D) then begin
     FD3D._Release;
     FD3D := nil;
  end;
end;

procedure TfrmD3D.ErrorOut (const Caption : PChar; const hError : HRESULT);
begin
  FActive := False;
  Cleanup;
  MessageBox (Handle, PChar(DXGErrorString (hError)), Caption, 0);
end;

function TfrmD3D.InitD3D : HRESULT;
var
  d3ddm : TD3DDISPLAYMODE;
  d3dpp : TD3DPRESENT_PARAMETERS;
  hRet : HRESULT;
begin
  FD3DDevice := nil;
  FD3DVB := nil;
  FD3D := nil;

  FD3D := Direct3DCreate8(D3D_SDK_VERSION);
  if FD3D = nil then begin
     Result := E_FAIL;
     Exit;
  end;

  hRet := FD3D.GetAdapterDisplayMode(D3DADAPTER_DEFAULT, d3ddm);
  if FAILED(hRet) then begin
     Result := hRet;
     Exit;
  end;

  ZeroMemory(@d3dpp, SizeOf(d3dpp));
  with d3dpp do begin
       Windowed := True;
       SwapEffect := D3DSWAPEFFECT_DISCARD;
       BackBufferFormat := d3ddm.Format;
       EnableAutoDepthStencil := True;
       AutoDepthStencilFormat := D3DFMT_D16;
  end;

  Result := FD3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Handle,
                              D3DCREATE_SOFTWARE_VERTEXPROCESSING,
                              d3dpp, FD3DDevice);
end;

var
  FogStart : Single = 0.5;
  FogEnd : Single = 1.0;

function TfrmD3D.Render : HRESULT;
var
  hRet : HRESULT;
begin
  if FD3DDevice = nil then begin
     Result := E_FAIL;
     Exit;
  end;

  hRet := FD3DDevice.Clear(0, nil, D3DCLEAR_TARGET or D3DCLEAR_ZBUFFER,
                                   $00FFFFFF, 1.0, 0);
  if FAILED(hRet) then begin
     Result := hRet;
     Exit;
  end;

  hRet := FD3DDevice.BeginScene;
  if FAILED(hRet) then begin
     Result := hRet;
     Exit;
  end;

  with FD3DDevice do begin
       SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);

       SetRenderState(D3DRS_FOGENABLE, DWORD (True));
       SetRenderState(D3DRS_FOGTABLEMODE, D3DFOG_LINEAR);
       SetRenderState(D3DRS_FOGCOLOR, $00FFFFFF);
       SetRenderState(D3DRS_FOGSTART, PDWORD (@FogStart)^);
       SetRenderState(D3DRS_FOGEND, PDWORD (@FogEnd)^);
  end;

  DrawScene;

  hRet := FD3DDevice.EndScene;
  if FAILED(hRet) then begin
     Result := hRet;
     Exit;
  end;

  Result := FD3DDevice.Present(nil, nil, 0, nil);
end;

procedure TfrmD3D.FormCreate(Sender: TObject);
var
  hRet : HRESULT;
  matView, matProj : TD3DMatrix;
begin
  hRet := InitD3D;
  if Failed (hRet) then ErrorOut ('InitD3D', hRet);
  hRet := InitVB;
  if Failed (hRet) then ErrorOut ('InitVertex', hRet);
  InitDodecahedron;

  SetViewMatrix(matView, D3DVector(0, 0, -4), D3DVector(0, 0, 0), D3DVector(0, 1, 0));
  FD3DDevice.SetTransform(D3DTS_VIEW, matView);

  SetProjectionMatrix(matProj, 1, 1, 1, 7);
  FD3DDevice.SetTransform(D3DTS_PROJECTION, matProj);
end;

procedure TfrmD3D.ApplicationEvents1Minimize(Sender: TObject);
begin
  FActive := False;
end;

procedure TfrmD3D.FormActivate(Sender: TObject);
begin
  LastTickCount := GetTickCount;
  FActive := True;
end;

procedure TfrmD3D.ApplicationEvents1Idle(Sender: TObject;
  var Done: Boolean);
var
  hRet : HRESULT;
begin
  if FActive then begin
     Inc (Frames);
     hRet := Render;
     if FAILED(hRet) then begin
        FActive := False;
        ErrorOut ('Render', hRet);
        Exit;
     end;

     ThisTickCount := GetTickCount;
     if ThisTickCount - LastTickCount > 15 then begin
        Caption := 'FPS = ' + Format('%6.2f',
                                 [frames * 1000 / (ThisTickCount - LastTickCount)]);
        Frames := 0;

        Angle := Angle + 0.05;
        if Angle > 2 * Pi then Angle := Angle - 2 * Pi;

        LastTickCount := GetTickCount;
     end;
  end;

  Done := False;
end;

procedure TfrmD3D.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then Close;
end;

procedure TfrmD3D.ApplicationEvents1Restore(Sender: TObject);
begin
  FActive := True;
end;

procedure TfrmD3D.FormDestroy(Sender: TObject);
begin
  Cleanup
end;

function TfrmD3D.InitVB : HRESULT;
var
  hRet : HRESULT;
begin
  hRet := FD3DDevice.CreateVertexBuffer(5 * SizeOf(TCustomVertex), 0,
                                        D3DFVF_CUSTOMVERTEX,
                                        D3DPOOL_DEFAULT, FD3DVB);
  if Failed(hRet) then begin
     Result := hRet;
     Exit;
  end;

  hRet := FD3DDevice.SetStreamSource(0, FD3DVB, SizeOf(TCustomVertex));
  if Failed(hRet) then begin
     Result := hRet;
     Exit;
  end;

  Result := FD3DDevice.SetVertexShader(D3DFVF_CUSTOMVERTEX);
end;

procedure TfrmD3D.DrawScene;
var
  matRotateX, matRotateY : TD3DMatrix;
begin
  SetRotateXMatrix(matRotateX, Angle);
  SetRotateYMatrix(matRotateY, Angle / 2);
  FD3DDevice.SetTransform(D3DTS_WORLD, MatrixMul(matRotateX, matRotateY));

  Dodecahedron;
end;

function TfrmD3D.Pentagon(const a, b, c, d, e : Integer) : HRESULT;
var
  hRet : HRESULT;
  Vertices : ^TCustomVertex;
begin
  hRet := FD3DVB.Lock(0, 5 * SizeOf(TCustomVertex), PByte(Vertices), 0);
  if Failed(hRet) then begin
     Result := hRet;
     Exit;
  end;

  Vertices.X := dodec[a, 0];
  Vertices.Y := dodec[a, 1];
  Vertices.Z := dodec[a, 2];
  Inc(Vertices);

  Vertices.X := dodec[b, 0];
  Vertices.Y := dodec[b, 1];
  Vertices.Z := dodec[b, 2];
  Inc(Vertices);

  Vertices.X := dodec[c, 0];
  Vertices.Y := dodec[c, 1];
  Vertices.Z := dodec[c, 2];
  Inc(Vertices);

  Vertices.X := dodec[d, 0];
  Vertices.Y := dodec[d, 1];
  Vertices.Z := dodec[d, 2];
  Inc(Vertices);

  Vertices.X := dodec[e, 0];
  Vertices.Y := dodec[e, 1];
  Vertices.Z := dodec[e, 2];

  hRet := FD3DVB.Unlock;
  if Failed(hRet) then begin
     Result := hRet;
     Exit;
  end;

  Result := FD3DDevice.DrawPrimitive(D3DPT_LINESTRIP, 0, 4);
end;

procedure TfrmD3D.Dodecahedron;
begin
  Pentagon(0, 1, 9, 16, 5);
  Pentagon(1, 0, 3, 18, 7);
  Pentagon(1, 7, 11, 10, 9);
  Pentagon(11, 7, 18, 19, 6);
  Pentagon(8, 17, 16, 9, 10);
  Pentagon(2, 14, 15, 6, 19);
  Pentagon(2, 13, 12, 4, 14);
  Pentagon(2, 19, 18, 3, 13);
  Pentagon(3, 0, 5, 12, 13);
  Pentagon(6, 15, 8, 10, 11);
  Pentagon(4, 17, 8, 15, 14);
  Pentagon(6, 11, 7, 18, 19);
end;

end.
