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:

procedure TFMain.FormCreate(Sender: TObject);
var mpp: TD3DPresentParameters;
begin
  ClientHeight:=768;
  ClientWidth:=1024;

  direct:=Direct3DCreate9(D3D_SDK_VERSION);
  if direct=nil then begin
    Showmessage('Fataler Fehler: DirectX konnte nicht initalisiert werden.');
    Application.Terminate;
    close;
    exit;
  end;

  fillchar(mpp,sizeof(mpp),0);
  mpp.BackBufferWidth:=1024;
  mpp.BackBufferHeight:=768;
  mpp.BackBufferFormat:=D3DFMT_A8R8G8B8;
  mpp.SwapEffect:=D3DSWAPEFFECT_DISCARD;
  mpp.Windowed:=true;
  mpp.EnableAutoDepthStencil:=true;
  mpp.AutoDepthStencilFormat:=D3DFMT_D16;
  if direct.CreateDevice(D3DADAPTER_DEFAULT, D3DDevType_HAL, self.Handle,
        D3DCREATE_SOFTWARE_VERTEXPROCESSING, mpp, Device)<>D3D_OK then begin
    Showmessage('Fataler Fehler: Das DirectXDevice konnte nicht initalisiert '+
                'werden.');
    Application.Terminate;
    close;
    exit;
  end;

  wrfl:=TV3DGeometry.Create(device);
  if not wrfl.Generate('TYPECUBECOLR'+Chr(255)+Chr(128)+Chr(255)) then
    Showmessage('Der Würfel lädt nicht!');

  Application.OnIdle:=OnIdle;
end;                    

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:

function TV3DGeometry.Setindex(pos,index: word): boolean;
var
  point: Pointer;
begin
  result:=false;
  if Fibuffer.Lock(pos*2,2,point,0) <>D3D_OK then exit;
  Move(index,point,2);
  if Fibuffer.Unlock<>D3D_OK then exit;
  result:=true;
end;

function TV3DGeometry.Setvertex(pos: word; color: TD3DColor;
      x,y,z: single): boolean;
var point: Pointer;
MVertex: TV3DNLVertex;
begin
  result:=false;
  if Fvbuffer.Lock(FVertexSize*pos,FVertexSize,point,0) <>D3D_OK then exit;
  MVertex.x:=x; MVertex.y:=y; MVertex.z:=z;
  Mvertex.diffuse:=color;
  Move(MVertex,point,FVertexsize);
  if Fvbuffer.Unlock<>D3D_OK then exit;
  result:=true;
end;

[...]
begin
    FVertices:=8;
    FIndices:=36;

    if Fdevice.CreateVertexBuffer(FVertexsize*8, D3DUSAGE_WRITEONLY,
                     FVertexformat, D3DPOOL_DEFAULT, Fvbuffer, nil)<>D3D_OK then
      exit;
    if not Setvertex(0,color,-1,-1,-1) then exit;
    if not Setvertex(1,color,-1,-1,1) then exit;
    if not Setvertex(2,color,1,-1,1) then exit;
    if not Setvertex(3,color,1,-1,-1) then exit;
    if not Setvertex(4,color,-1,1,-1) then exit;
    if not Setvertex(5,color,-1,1,1) then exit;
    if not Setvertex(6,color,1,1,1) then exit;
    if not Setvertex(7,color,1,1,-1) then exit;

    if Fdevice.CreateIndexBuffer(FIndices*2, D3DUSAGE_WRITEONLY,D3DFMT_INDEX16,
                                    D3DPOOL_DEFAULT, Fibuffer, nil)<>D3D_OK then
      exit;
    if not Setindex(0,0) then exit;     if not Setindex(1,2) then exit;
    if not Setindex(2,1) then exit;     if not Setindex(3,0) then exit;
    if not Setindex(4,3) then exit;     if not Setindex(5,2) then exit;
    if not Setindex(6,4) then exit;     if not Setindex(7,3) then exit;
    if not Setindex(8,0) then exit;     if not Setindex(9,4) then exit;
    if not Setindex(10,7) then exit;    if not Setindex(11,3) then exit;
    if not Setindex(12,4) then exit;    if not Setindex(13,5) then exit;
    if not Setindex(14,7) then exit;    if not Setindex(15,5) then exit;
    if not Setindex(16,6) then exit;    if not Setindex(17,7) then exit;
    if not Setindex(18,5) then exit;    if not Setindex(19,1) then exit;
    if not Setindex(20,6) then exit;    if not Setindex(21,1) then exit;
    if not Setindex(22,2) then exit;    if not Setindex(23,6) then exit;
    if not Setindex(24,0) then exit;    if not Setindex(25,1) then exit;
    if not Setindex(26,5) then exit;    if not Setindex(27,5) then exit;
    if not Setindex(28,4) then exit;    if not Setindex(29,0) then exit;
    if not Setindex(30,2) then exit;    if not Setindex(31,7) then exit;
    if not Setindex(32,6) then exit;    if not Setindex(33,2) then exit;
    if not Setindex(34,3) then exit;    if not Setindex(35,7) then exit;
    Fisload:=true;
end;[...]                    

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:

procedure Setupview;
var pos,dir,up: TD3DXVector3;
cammat: TD3DXMatrix;
begin
  pos:=D3DXVector3(random(5),0,-5);
  dir:=D3DXVector3(0,0,0);
  up:=D3DXVector3(0,1,0);

  D3DXMatrixlookAtLH(cammat,pos,dir,up);
  device.SetTransform(D3DTS_VIEW,cammat);
  D3DXMatrixPerspectiveFovLH(cammat,0.7854,1.333,1,1024);
  device.SetTransform(D3DTS_PROJECTION,cammat);
end;

procedure TFMain.OnIdle(Sender: TObject; var done: boolean);
begin
  randomize;

  device.BeginScene;
  device.Clear(0,nil,D3DCLEAR_TARGET or D3DCLEAR_ZBUFFER,
               D3DCOLOR_ARGB(0,255,255,255), 1.0, 0);

  Setupview;

  if not wrfl.Render then Showmessage('beim Rendern eines Würfels abgekappt');

  device.EndScene;
  device.Present(nil, nil, 0, nil);

  done:=false;
end;

function TV3DGeometry.Render: boolean;
var Lighting: Longword;
begin
  result:=false;
  if fdevice.GetRenderState(D3DRS_LIGHTING, Lighting)<>D3D_OK then exit;
  if fdevice.Setrenderstate(D3DRS_LIGHTING, Longword(false))<>D3D_OK then exit;
  if fdevice.Setrenderstate(D3DRS_CULLMODE, Longword(false))<>D3D_OK then exit;
  if fdevice.SetTransform(D3DTS_WORLDMATRIX(0),Fmatrix)<>D3D_OK then exit;

  if fdevice.SetFVF(FVertexformat)<>D3D_OK then exit;
  if fdevice.SetStreamSource(0,fvbuffer, 0, FVertexsize)<>D3D_OK then exit;
  if fdevice.SetIndices(fibuffer)<>D3D_OK then exit;
  if fdevice.DrawIndexedPrimitive(d3dpt_TriangleList,0,0,FVertices,0,
        FIndices div 3)<>D3D_OK then exit;

  if fdevice.Setrenderstate(D3DRS_LIGHTING, Lighting)<>D3D_OK then exit;
  result:=true;
end;