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

interface

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

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);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ApplicationEvents1Deactivate(Sender: TObject);
  private
    { Private declarations }
    FD3D            : IDIRECT3D8;
    FD3DDevice      : IDIRECT3DDEVICE8;
    FD3DVB          : IDIRECT3DVERTEXBUFFER8;
    FActive         : BOOL;
    ThisTickCount   : DWORD;
    LastTickCount   : DWORD;
    function Render : HRESULT;
    function InitD3D : HRESULT;
    function InitPoints : HRESULT;
    function DrawPoints : HRESULT;
    function Draw2DTriangle (const inX, inY : Single) : HRESULT;
    function Draw2DQuad (const inX, inY : Single) : HRESULT;
    procedure Cleanup;
    procedure ErrorOut (const Caption : PChar; const hError : HRESULT);
  public
    { Public declarations }
  end;

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

const
  D3DFVF_CUSTOMVERTEX = D3DFVF_XYZRHW or D3DFVF_DIFFUSE;
  Radius = 180;

var
  frmD3D: TfrmD3D;

  VPoints : Array [0..500] of TCUSTOMVERTEX;
  VTriangle : Array [0..2] of TCUSTOMVERTEX;
  VQuad : Array [0..3] of TCUSTOMVERTEX;

implementation

{$R *.DFM}

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;

const
  fmtFullscreenArray : Array [0..4] of DWORD =
       (D3DFMT_R5G6B5,
        D3DFMT_X1R5G5B5,
        D3DFMT_A1R5G5B5,
        D3DFMT_X8R8G8B8,
        D3DFMT_A8R8G8B8);

var
  FD3DfmtFullscreen : DWORD;
  ScreenWidth, ScreenHeight : Integer;
  HalfScreenWidth, HalfScreenHeight : Integer;
  d3dpp : TD3DPRESENT_PARAMETERS;

function TfrmD3D.InitD3D : HRESULT;
var
  iFmt : Integer;
begin
  if FD3D = nil then FD3D := Direct3DCreate8(D3D_SDK_VERSION);
  if FD3D = nil then begin
     Result := E_FAIL;
     Exit;
  end;

  for iFmt := 0 to High(fmtFullscreenArray) do begin
      if( SUCCEEDED( FD3D.CheckDeviceType( D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL,
            fmtFullscreenArray[iFmt], fmtFullscreenArray[iFmt], FALSE ) ) )
        then begin
            FD3DfmtFullscreen := fmtFullscreenArray[iFmt];
            Break;
        end
  end;

  ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
  ScreenHeight := GetSystemMetrics(SM_CYSCREEN);

  HalfScreenWidth := ScreenWidth div 2;
  HalfScreenHeight := ScreenHeight div 2;

  ZeroMemory(@d3dpp, SizeOf(d3dpp));
  with d3dpp do begin
       Windowed := False;
       SwapEffect := D3DSWAPEFFECT_DISCARD;
       BackBufferWidth  := ScreenWidth;
       BackBufferHeight := ScreenHeight;
       BackBufferFormat := FD3DfmtFullscreen;
  end;

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

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, 0, 0.0, 0);
  if FAILED(hRet) then begin
     Result := hRet;
     Exit;
  end;

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

  hRet := DrawPoints;
  if FAILED(hRet) then begin
     Result := hRet;
     Exit;
  end;

  with FD3DDevice do begin
       SetRenderState(D3DRS_ALPHABLENDENABLE, DWORD(True));
       SetRenderState(D3DRS_SRCBLEND, D3DBLEND_ONE);
       SetRenderState(D3DRS_DESTBLEND, D3DBLEND_ONE);
  end;

  hRet := Draw2DQuad (HalfScreenWidth, HalfScreenHeight);
  if FAILED(hRet) then begin
     Result := hRet;
     Exit;
  end;

  hRet := Draw2DTriangle (HalfScreenWidth, HalfScreenHeight);
  if FAILED(hRet) then begin
     Result := hRet;
     Exit;
  end;

  FD3DDevice.SetRenderState(D3DRS_ALPHABLENDENABLE, DWORD(False));

  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;
begin
  ShowCursor (False);
  FD3DDevice := nil;
  FD3DVB := nil;
  FD3D := nil;

  hRet := InitD3D;
  if Failed (hRet) then ErrorOut ('InitD3D', hRet);
  hRet := InitPoints;
  if Failed (hRet) then ErrorOut ('InitPoint', hRet);
end;

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

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

var
  Angle : Single = 0.0;

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

     ThisTickCount := GetTickCount;
     if ThisTickCount - LastTickCount > 30 then begin

        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
  if Assigned (FD3DVB) then begin
     FD3DVB._Release;
     FD3DVB := nil;
  end;
  WindowState := wsMaximized;  
  InitD3D;
  InitPoints;
  FActive := True;
end;

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

function TfrmD3D.InitPoints : HRESULT;
var
  hRet : HRESULT;
  i : Integer;
  wrkDWORD : DWORD;
begin
  Randomize;

  for i := 0 to High (VPoints) do begin
      wrkDWORD := random (200) + 40;
      with VPoints [i] do begin
           X := random (ScreenWidth);
           Y := random (ScreenHeight);
           Z := 0.0;
           RHW := 1.0;
           Color := D3DCOLOR_XRGB(wrkDWORD, wrkDWORD, wrkDWORD);
      end;
  end;

  for i := 0 to High (VTriangle) do
      with VTriangle [i] do begin
           Z := 0.0;
           RHW := 1.0;
  end;

  VTriangle [0].Color := D3DCOLOR_XRGB(255, 0, 0);
  VTriangle [1].Color := D3DCOLOR_XRGB(0, 255, 0);
  VTriangle [2].Color := D3DCOLOR_XRGB(0, 0, 255);

  for i := 0 to High (VQuad) do
      with VQuad [i] do begin
           Z := 0.0;
           RHW := 1.0;
           Color := D3DCOLOR_XRGB(100, 100, 100);
  end;

  hRet := FD3DDevice.CreateVertexBuffer(SizeOf(VPoints),
                                        D3DUSAGE_WRITEONLY, 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;

function TfrmD3D.DrawPoints : HRESULT;
var
  pVertices : PByte;
  hRet : HRESULT;
begin
  hRet := FD3DVB.Lock(0, SizeOf(VPoints), pVertices, 0);
  if Failed (hRet) then begin
     Result := hRet;
     Exit;
  end;

  Move (VPoints, pVertices^, SizeOf(VPoints));

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

  Result := FD3DDevice.DrawPrimitive(D3DPT_POINTLIST, 0, High (VPoints) + 1);
end;

procedure TfrmD3D.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Hide;
end;

procedure TfrmD3D.ApplicationEvents1Deactivate(Sender: TObject);
begin
  FActive := False;
  Application.Minimize;
end;

const
  Pidiv3 = 2 * Pi / 3;

function TfrmD3D.Draw2DTriangle (const inX, inY : Single) : HRESULT;
var
  pVertices : PByte;
  hRet : HRESULT;
begin
  with VTriangle [0] do begin
       X := inX + Radius * cos (-Angle);
       Y := inY + Radius * sin (-Angle);
  end;

  with VTriangle [1] do begin
       X := inX + Radius * cos (-Angle + Pidiv3);
       Y := inY + Radius * sin (-Angle + Pidiv3);
  end;

  with VTriangle [2] do begin
       X := inX + Radius * cos (-Angle + 2 * Pidiv3);
       Y := inY + Radius * sin (-Angle + 2 * Pidiv3);
  end;

  hRet := FD3DVB.Lock(0, SizeOf(VTriangle), pVertices, 0);
  if Failed (hRet) then begin
     Result := hRet;
     Exit;
  end;

  Move (VTriangle , pVertices^, SizeOf(VTriangle));

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

  Result := FD3DDevice.DrawPrimitive(D3DPT_TRIANGLELIST, 0, 1);
end;

const
  HalfPi = Pi / 2;

function TfrmD3D.Draw2DQuad (const inX, inY : Single) : HRESULT;
var
  pVertices : PByte;
  hRet : HRESULT;
begin
  with VQuad [0] do begin
       X := inX + Radius * cos (Angle / 2 - HalfPi);
       Y := inY + Radius * sin (Angle / 2 - HalfPi);
  end;

  with VQuad [1] do begin
       X := inX + Radius * cos (Angle / 2);
       Y := inY + Radius * sin (Angle / 2);
  end;

  with VQuad [2] do begin
       X := inX + Radius * cos (Angle / 2 + Pi);
       Y := inY + Radius * sin (Angle / 2 + Pi);
  end;

  with VQuad [3] do begin
       X := inX + Radius * cos (Angle / 2 + HalfPi);
       Y := inY + Radius * sin (Angle / 2 + HalfPi);
  end;

  hRet := FD3DVB.Lock(0, SizeOf(VQuad), pVertices, 0);
  if Failed (hRet) then begin
     Result := hRet;
     Exit;
  end;

  Move (VQuad, pVertices^, SizeOf(VQuad));

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

  Result := FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 0, 2);
end;

end.
