{******************************************************************************}
{* Иллюстрация к книге "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);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FD3D            : IDIRECT3D8;
    FD3DDevice      : IDIRECT3DDEVICE8;
    FD3DVB          : IDIRECT3DVERTEXBUFFER8;
    FActive         : BOOL;
    MaterialRed     : TD3DMaterial8;
    MaterialBlue    : TD3DMaterial8;
    MaterialGreen   : TD3DMaterial8;
    MaterialYellow  : TD3DMaterial8;
    ThisTickCount   : DWORD;
    LastTickCount   : DWORD;
    function Render : HRESULT;
    function InitD3D : HRESULT;
    function InitVB : HRESULT;
    procedure DrawScene;
    procedure Timer;
    procedure Cleanup;
    procedure SetupLights;
    procedure ErrorOut (const Caption : PChar; const hError : HRESULT);
  public
    { Public declarations }
  end;

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

const
  D3DFVF_CUSTOMVERTEX = D3DFVF_XYZ or D3DFVF_NORMAL;
  INCR = 0.05;

var
  frmD3D: TfrmD3D;
  Frames : Integer = 0;

  Down : BOOL = False;

  oX : Integer;
  oY : Integer;
  Angle : Single = 0;
  sHeight : Single = 0;

  R_hand_up_angle,
  R_hand_down_angle,
  L_hand_up_angle,
  L_hand_down_angle,
  R_foot_up_angle,
  R_foot_down_angle,
  L_foot_up_angle,
  L_foot_down_angle : Single;
  R_hand_move,
  L_hand_move,
  R_foot_move,
  L_foot_move : BOOL;

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;

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;

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_CULLMODE, D3DCULL_CCW);
       SetRenderState(D3DRS_ZENABLE, D3DZB_TRUE);
       SetRenderState(D3DRS_NORMALIZENORMALS, DWORD (True));
  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);
  SetupLights;
  MaterialRed := InitMaterial(1, 0, 0, 1);
  MaterialBlue := InitMaterial(0, 0, 1, 1);
  MaterialGreen := InitMaterial(0, 1, 0, 1);
  MaterialYellow  := InitMaterial(1, 1, 0, 1);

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

  SetProjectionMatrix(matProj, 1, 1, 1, 20);
  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;

        LastTickCount := GetTickCount;
     end;
  end;

  Done := False;
end;

procedure TfrmD3D.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then Close else
  if Key = VK_LEFT then R_hand_move := not R_hand_move else
  if Key = VK_RIGHT then L_hand_move := not L_hand_move else
  if Key = VK_UP then begin
     if L_foot_up_angle < 1.0 then R_foot_move := not R_foot_move;
  end else
  if Key = VK_DOWN then begin
     if R_foot_up_angle < 1.0 then L_foot_move := not L_foot_move;
  end;
end;

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

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

function TfrmD3D.InitVB : HRESULT;
const
  Radius = 0.1;
var
  Vertices : ^TCustomVertex;
  hRet : HRESULT;
  theta : Single;
  i : Integer;
begin
  hRet := FD3DDevice.CreateVertexBuffer((60 + 200) * 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;

  hRet := FD3DDevice.SetVertexShader(D3DFVF_CUSTOMVERTEX);
  if Failed(hRet) then begin
     Result := hRet;
     Exit;
  end;

  hRet := FD3DVB.Lock(0, 260 * SizeOf(TCustomVertex), PByte(Vertices), 0);
  if Failed(hRet) then begin
     Result := hRet;
     Exit;
  end;

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY :=  3.56822069020721E-0001;
  Vertices.nZ :=  9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY :=  3.56822069020721E-0001;
  Vertices.nZ :=  9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY :=  3.56822069020721E-0001;
  Vertices.nZ :=  9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -3.56822069020721E-0001;
  Vertices.nY :=  9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX := -3.56822069020721E-0001;
  Vertices.nY :=  9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX := -3.56822069020721E-0001;
  Vertices.nY :=  9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX :=  3.56822069020721E-0001;
  Vertices.nY :=  9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  3.56822069020721E-0001;
  Vertices.nY :=  9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX :=  3.56822069020721E-0001;
  Vertices.nY :=  9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ :=  3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX :=  9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ :=  3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ :=  3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ := -3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ := -3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX :=  9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ := -3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY :=  3.56822069020721E-0001;
  Vertices.nZ := -9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY :=  3.56822069020721E-0001;
  Vertices.nZ := -9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY :=  3.56822069020721E-0001;
  Vertices.nZ := -9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX := 0.0;
  Vertices.nY := -3.56822069020721E-0001;
  Vertices.nZ := -9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX := 0.0;
  Vertices.nY := -3.56822069020721E-0001;
  Vertices.nZ := -9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX := 0.0;
  Vertices.nY := -3.56822069020721E-0001;
  Vertices.nZ := -9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX :=  3.56822069020721E-0001;
  Vertices.nY := -9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  3.56822069020721E-0001;
  Vertices.nY := -9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX :=  3.56822069020721E-0001;
  Vertices.nY := -9.34172429310231E-0001;
  Vertices.nZ :=  0.0;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX := -3.56822069020721E-0001;
  Vertices.nY := -9.34172429310231E-0001;
  Vertices.nZ := 0.0;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX := -3.56822069020721E-0001;
  Vertices.nY := -9.34172429310231E-0001;
  Vertices.nZ := 0.0;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -3.56822069020721E-0001;
  Vertices.nY := -9.34172429310231E-0001;
  Vertices.nZ := 0.0;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY := -3.56822069020721E-0001;
  Vertices.nZ :=  9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY := -3.56822069020721E-0001;
  Vertices.nZ :=  9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX :=  0.0;
  Vertices.nY := -3.56822069020721E-0001;
  Vertices.nZ :=  9.34172429310231E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z :=  5.25731141223711E-0001;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX :=  5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ :=  5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ :=  3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ :=  3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z :=  8.50650914724250E-0001;
  Vertices.nX := -9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ :=  3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ := -3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX := -9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ := -3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -9.34172429310231E-0001;
  Vertices.nY :=  0.0;
  Vertices.nZ := -3.56822069020721E-0001;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y :=  5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y :=  8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY :=  5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X :=  0.0;
  Vertices.Y := -8.50650914724250E-0001;
  Vertices.Z := -5.25731141223711E-0001;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X := -8.50650914724250E-0001;
  Vertices.Y := -5.25731141223711E-0001;
  Vertices.Z :=  0.0;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  Vertices.X := -5.25731141223711E-0001;
  Vertices.Y :=  0.0;
  Vertices.Z := -8.50650914724250E-0001;
  Vertices.nX := -5.77350325929771E-0001;
  Vertices.nY := -5.77350325929771E-0001;
  Vertices.nZ := -5.77350325929771E-0001;
  Inc(Vertices);

  for i := 49 downto 0 do begin
    theta := 2 * Pi * i / 49;
    Vertices.X := sin(theta) * Radius;
    Vertices.Y := 0;
    Vertices.Z := cos(theta) * Radius;
    Vertices.nX := sin(theta);
    Vertices.nY := 0;
    Vertices.nZ := cos(theta);
    Inc(Vertices);
    Vertices.X := sin(theta) * Radius;
    Vertices.Y := 1;
    Vertices.Z := cos(theta) * Radius;
    Vertices.nX := sin(theta);
    Vertices.nY := 0;
    Vertices.nZ := cos(theta);
    Inc(Vertices);
  end;

  for i := 49 downto 0 do begin
    theta := 2 * Pi * i / 49;
    Vertices.X := sin(theta) * Radius;
    Vertices.Y := 0;
    Vertices.Z := cos(theta) * Radius;
    Vertices.nX := sin(theta);
    Vertices.nY := 0;
    Vertices.nZ := cos(theta);
    Inc(Vertices);
    Vertices.X := sin(theta) * Radius;
    Vertices.Y := 0.75;
    Vertices.Z := cos(theta) * Radius;
    Vertices.nX := sin(theta);
    Vertices.nY := 0;
    Vertices.nZ := cos(theta);
    Inc(Vertices);
  end;

  Result := FD3DVB.Unlock;
end;

procedure TfrmD3D.DrawScene;
var
  matRotateX, matRotateZ : TD3DMatrix;
  matScale, matTranslate : TD3DMatrix;
  matWrk : TD3DMatrix;
begin
  Timer;

  SetTranslateMatrix(matTranslate, 0.0, -3.0, 0.0);
  SetScaleMatrix (matScale, 0.5, 0.5, 0.5);
  matWrk := MatrixMul(matScale, matTranslate);
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       SetMaterial(MaterialYellow);
       DrawPrimitive(D3DPT_TRIANGLELIST, 0, 20);
  end;

  SetTranslateMatrix(matTranslate, -0.2, 0.0, 0.0);
  SetRotateXMatrix(matRotateX, L_foot_up_angle);
  matWrk := MatrixMul(matTranslate, matRotateX);
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       SetMaterial(MaterialBlue);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
  end;

  SetTranslateMatrix(matTranslate, 0.0, 1.0, 0.0);
  SetRotateXMatrix(matRotateX, L_foot_down_angle);
  matWrk := MatrixMul(matWrk, MatrixMul(matTranslate, matRotateX));
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
  end;

  SetTranslateMatrix(matTranslate, 0.2, 0.0, 0.0);
  SetRotateXMatrix(matRotateX, R_foot_up_angle);
  matWrk := MatrixMul(matTranslate, matRotateX);
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
  end;

  SetTranslateMatrix(matTranslate, 0.0, 1.0, 0.0);
  SetRotateXMatrix(matRotateX, R_foot_down_angle);
  matWrk := MatrixMul(matWrk, MatrixMul(matTranslate, matRotateX));
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
  end;

  SetTranslateMatrix(matTranslate, -0.2, 0.0, 0.0);
  SetRotateZMatrix(matRotateZ, 5 * Pi / 6);
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, MatrixMul(matTranslate, matRotateZ));
       SetMaterial(MaterialGreen);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);
  end;

  SetTranslateMatrix(matTranslate, 0.2, 0.0, 0.0);
  SetRotateZMatrix(matRotateZ, -5 * Pi / 6);
  FD3DDevice.SetTransform(D3DTS_WORLD, MatrixMul(matTranslate, matRotateZ));
  FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);

  SetTranslateMatrix(matTranslate, -1.0, -1.0, 0.0);
  SetScaleMatrix (matScale, 1.0, 2.0, 1.0);
  SetRotateZMatrix(matRotateZ, Pi / 2);
  FD3DDevice.SetTransform(D3DTS_WORLD, MatrixMul(matRotateZ,
      MatrixMul(matTranslate, matScale)));
  FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);

  SetTranslateMatrix(matTranslate, 0.0, -0.25, 0.0);
  SetScaleMatrix (matScale, 1.0, 0.5, 1.0);
  SetRotateZMatrix(matRotateZ, Pi / 2);
  FD3DDevice.SetTransform(D3DTS_WORLD, MatrixMul(matRotateZ,
      MatrixMul(matTranslate, matScale)));
  FD3DDevice.DrawPrimitive(D3DPT_TRIANGLESTRIP, 60, 98);

  SetTranslateMatrix(matTranslate, -1.0, -1.0, 0.0);
  SetRotateZMatrix(matRotateZ, R_hand_up_angle);
  matWrk := MatrixMul(matTranslate, matRotateZ);
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       SetMaterial(MaterialRed);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 160, 98);
  end;

  SetTranslateMatrix(matTranslate, 0.0, 0.75, 0.0);
  SetRotateZMatrix(matRotateZ, R_hand_down_angle);
  matWrk := MatrixMul(matWrk, MatrixMul(matTranslate, matRotateZ));
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 160, 98);
  end;

  SetTranslateMatrix(matTranslate, 1.0, -1.0, 0.0);
  SetRotateZMatrix(matRotateZ, L_hand_up_angle);
  matWrk := MatrixMul(matTranslate, matRotateZ);
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 160, 98);
  end;

  SetTranslateMatrix(matTranslate, 0.0, 0.75, 0.0);
  SetRotateZMatrix(matRotateZ, L_hand_down_angle);
  matWrk := MatrixMul(matWrk, MatrixMul(matTranslate, matRotateZ));
  with FD3DDevice do begin
       SetTransform(D3DTS_WORLD, matWrk);
       DrawPrimitive(D3DPT_TRIANGLESTRIP, 160, 98);
  end;
end;

procedure TfrmD3D.SetupLights;
var
  Light0     : TD3DLight8;
  Light1     : TD3DLight8;
begin
  Light0 := InitDirectionalLight(D3DVector(1, 0, -1), 1, 1, 1, 0);
  Light1 := InitDirectionalLight(D3DVector(-1, 0, 0), 1, 1, 1, 0);

  FD3DDevice.SetLight(0, Light0);
  FD3DDevice.SetLight(1, Light1);

  FD3DDevice.LightEnable(0, True);
  FD3DDevice.LightEnable(1, True);
end;

procedure TfrmD3D.Timer;
begin
  if R_hand_move then begin
    if R_hand_up_angle < Pi / 2 then begin
       R_hand_up_angle := R_hand_up_angle + INCR;
       R_hand_down_angle := R_hand_down_angle - INCR;
       end
       else if (R_hand_up_angle >= Pi / 2) and (R_hand_down_angle < 0.0)
                then R_hand_down_angle := R_hand_down_angle + INCR;
    end else
    if R_hand_up_angle > 0.0 then begin
       R_hand_up_angle := R_hand_up_angle - INCR;
       if R_hand_down_angle < 0.0
          then R_hand_down_angle := R_hand_down_angle + INCR;
  end;

  if L_hand_move then begin
    if L_hand_up_angle > -Pi / 2 then begin
       L_hand_up_angle := L_hand_up_angle - INCR;
       L_hand_down_angle := L_hand_down_angle + INCR;
       end else if (L_hand_up_angle <= Pi / 2) and (L_hand_down_angle > 0.0)
           then	L_hand_down_angle := L_hand_down_angle - INCR;
     end else
     if L_hand_up_angle < 0.0 then begin
	L_hand_up_angle := L_hand_up_angle + INCR;
	if L_hand_down_angle > 0.0
           then L_hand_down_angle := L_hand_down_angle - INCR;
  end;

  if R_foot_move then begin
    if R_foot_up_angle < Pi / 2 then begin
       R_foot_up_angle := R_foot_up_angle + INCR;
       R_foot_down_angle := R_foot_down_angle - INCR;
    end else
    if (R_foot_up_angle >= Pi / 2) and (R_foot_down_angle < 0.0)
       then R_foot_down_angle := R_foot_down_angle + INCR;
    end else
	if R_foot_up_angle > 0.0 then begin
	   R_foot_up_angle := R_foot_up_angle - INCR;
	   if R_foot_down_angle < 0.0
              then R_foot_down_angle := R_foot_down_angle + INCR;
  end;

  if L_foot_move then begin
    if L_foot_up_angle < Pi / 2 then begin
       L_foot_up_angle := L_foot_up_angle + INCR;
       L_foot_down_angle := L_foot_down_angle - INCR;
    end	else
    if (L_foot_up_angle >= Pi / 2) and (L_foot_down_angle < 0.0)
       then L_foot_down_angle := L_foot_down_angle + INCR;
   end else
       if L_foot_up_angle > 0.0 then begin
	  L_foot_up_angle := L_foot_up_angle - INCR;
	  if L_foot_down_angle < 0.0
             then L_foot_down_angle := L_foot_down_angle + INCR;
   end;
end;

procedure TfrmD3D.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  eyeX, eyeZ : Single;
  matView : TD3DMatrix;
begin
  if Down then begin
     Angle := Angle + (X - oX) / 50.0;
     sHeight := sHeight + (Y - oY) / 15.0;
     eyeX := cos(Angle) * 5;
     eyeZ := sin(Angle) * 5;

     SetViewMatrix(matView, D3DVector(eyeX, sHeight, eyeZ), D3DVector(0, 0, 0), D3DVector(0, -1, 0));
     FD3DDevice.SetTransform(D3DTS_VIEW, matView);

     oX := X;
     oY := Y;
  end;
end;

procedure TfrmD3D.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Down := True;
  oX := X;
  oY := Y;
end;

procedure TfrmD3D.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Down := False;
end;

end.
