[FMX]3D Material Layer

[Darlo]

Ich hatte mal zum Test drei sich drehende 3D-Würfel gebaut die jeweils ein anderes Bild als Textur drauf hatten.
Habe den Code aus einem Tutorial, die Kommentare stehen auch noch drin. Leider kann ich den Urheber des urspünglichen Codes nicht nennen

Ist von mir aber wirklich quick and dirty umgebaut....

Delphi-Quellcode:

unit wuerfel3D;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Direct3D8, d3dx8, ExtCtrls, StdCtrls;

const

  CubeCount = 36;

type
// Unsere Struktur, in der wir die Dreiecke speichern
  TMyVertex = record
    x,y,z     : single;   // Position des Vertex
    color     : dword;    // Farbe des Vertex
    tu,tv     : single;   // Die Koordinaten der Textur
    end;

  // Vertexliste für Würfel
  TCube = array [0..CubeCount-1] of TMyVertex;

const
// Beschreibung des Vertextyps: Mit D3DFVF_DIFFUSE sagen wir DX, das unsere
// Struktur eine Farbe hat. D3DFVF_XYZ bedeutet, das es sich um ein untransformiertes
// Vertex handelt
  D3D8T_CUSTOMVERTEX =D3DFVF_XYZ or D3DFVF_DIFFUSE or D3DFVF_TEX1;

  NormCube : TCube = (
    (x :-1.0; y :-1.0; z :-1.0; color : $000000FF; tu : 0; tv : 1),  // Vorn
    (x :-1.0; y : 1.0; z :-1.0; color : $000000FF; tu : 0; tv : 0),
    (x : 1.0; y : 1.0; z :-1.0; color : $000000FF; tu : 1; tv : 0),
    (x : 1.0; y : 1.0; z :-1.0; color : $000000FF; tu : 1; tv : 0),
    (x : 1.0; y :-1.0; z :-1.0; color : $000000FF; tu : 1; tv : 1),
    (x :-1.0; y :-1.0; z :-1.0; color : $000000FF; tu : 0; tv : 1),

    (x :-1.0; y :-1.0; z : 1.0; color : $00FF00FF; tu : 0; tv : 1),  // Links
    (x :-1.0; y : 1.0; z : 1.0; color : $00FF00FF; tu : 0; tv : 0),
    (x :-1.0; y : 1.0; z :-1.0; color : $00FF00FF; tu : 1; tv : 0),
    (x :-1.0; y : 1.0; z :-1.0; color : $00FF00FF; tu : 1; tv : 0),
    (x :-1.0; y :-1.0; z :-1.0; color : $00FF00FF; tu : 1; tv : 1),
    (x :-1.0; y :-1.0; z : 1.0; color : $00FF00FF; tu : 0; tv : 1),

    (x : 1.0; y :-1.0; z : 1.0; color : $0000FF00; tu : 0; tv : 1),  // Hinten
    (x : 1.0; y : 1.0; z : 1.0; color : $0000FF00; tu : 0; tv : 0),
    (x :-1.0; y : 1.0; z : 1.0; color : $0000FF00; tu : 1; tv : 0),
    (x :-1.0; y : 1.0; z : 1.0; color : $0000FF00; tu : 1; tv : 0),
    (x :-1.0; y :-1.0; z : 1.0; color : $0000FF00; tu : 1; tv : 1),
    (x : 1.0; y :-1.0; z : 1.0; color : $0000FF00; tu : 0; tv : 1),

    (x : 1.0; y :-1.0; z :-1.0; color : $0000FFFF; tu : 0; tv : 1),  // Rechts
    (x : 1.0; y : 1.0; z :-1.0; color : $0000FFFF; tu : 0; tv : 0),
    (x : 1.0; y : 1.0; z : 1.0; color : $0000FFFF; tu : 1; tv : 0),
    (x : 1.0; y : 1.0; z : 1.0; color : $0000FFFF; tu : 1; tv : 0),
    (x : 1.0; y :-1.0; z : 1.0; color : $0000FFFF; tu : 1; tv : 1),
    (x : 1.0; y :-1.0; z :-1.0; color : $0000FFFF; tu : 0; tv : 1),

    (x :-1.0; y : 1.0; z :-1.0; color : $00FF0000; tu : 0; tv : 1),  // Oben
    (x :-1.0; y : 1.0; z : 1.0; color : $00FF0000; tu : 0; tv : 0),
    (x : 1.0; y : 1.0; z : 1.0; color : $00FF0000; tu : 1; tv : 0),
    (x : 1.0; y : 1.0; z : 1.0; color : $00FF0000; tu : 1; tv : 0),
    (x : 1.0; y : 1.0; z :-1.0; color : $00FF0000; tu : 1; tv : 1),
    (x :-1.0; y : 1.0; z :-1.0; color : $00FF0000; tu : 0; tv : 1),

    (x : 1.0; y :-1.0; z :-1.0; color : $00FFFF00; tu : 0; tv : 1),  // Unten
    (x : 1.0; y :-1.0; z : 1.0; color : $00FFFF00; tu : 0; tv : 0),
    (x :-1.0; y :-1.0; z : 1.0; color : $00FFFF00; tu : 1; tv : 0),
    (x :-1.0; y :-1.0; z : 1.0; color : $00FFFF00; tu : 1; tv : 0),
    (x :-1.0; y :-1.0; z :-1.0; color : $00FFFF00; tu : 1; tv : 1),
    (x : 1.0; y :-1.0; z :-1.0; color : $00FFFF00; tu : 0; tv : 1));

type
  TFrmwuerfel3d = class(TForm)
    timerWuerfel3D: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);



    procedure D3DInit(myphwnd: hwnd; lpd3dD_Nr: Integer);
    procedure D3DShutdown(lpd3dD_Nr: Integer);
    procedure D3DInitScene(lpd3dD_Nr: Integer);
    procedure D3DKillScene(lpd3dD_Nr: Integer);
    procedure D3DRender(lpd3dD_Nr: Integer);
    procedure timerWuerfel3DTimer(Sender: TObject);

  private
    { Private-Deklarationen }
    // Das main Direct3D Interface, es wird zum initialisieren und schließen von D3D benötigt
    lpd3d             : IDIRECT3D8;
    lpd3d2            : IDIRECT3D8;
    lpd3d3            : IDIRECT3D8;
    lpd3d4            : IDIRECT3D8;

    // Das D3DDevice wird zum Rendern benutzt und spiegelt den Bildschirm mit allen
    // Funktionen wieder. Wenn wir das D3DRender Interface erstellen, verändern oder
    // das Bild rendern, so machen wir das über dieses Interface
    lpd3ddevice       : IDirect3DDevice8;
    lpd3ddevice2      : IDirect3DDevice8;
    lpd3ddevice3      : IDirect3DDevice8;
    lpd3ddevice4      : IDirect3DDevice8;

    // Buffer, der die Vertizes des Würfels enthält
    CubeVB : IDirect3DVertexBuffer8;
    CubeVB2 : IDirect3DVertexBuffer8;
    CubeVB3 : IDirect3DVertexBuffer8;
    CubeVB4 : IDirect3DVertexBuffer8;

    // Textur des Würfels
    CubeTexture   : IDIRECT3DTEXTURE8;
    CubeTexture2   : IDIRECT3DTEXTURE8;
    CubeTexture3   : IDIRECT3DTEXTURE8;
    CubeTexture4   : IDIRECT3DTEXTURE8;

    RotX,RotY,RotZ   : single  ;  //Rotation des Würfels um die drei Achsen

    procedure FatalError(hr : HResult; FehlerMsg : string);

  public
    { Public-Deklarationen }

  end;

var
  frmwuerfel3d: TFrmwuerfel3d;
    texture_picture: PChar;
    texture_picture2: PChar;
    texture_picture3: PChar;
    texture_picture4: PChar;

    Animate          : boolean;
    Animate2          : boolean;
    Animate3          : boolean;
    Animate4          : boolean;

implementation

uses Unit1, Unit2;


{$R *.DFM}

// Initialisieren aller Variablen
procedure TFrmwuerfel3d.FormCreate(Sender: TObject);
begin
  texture_picture := PCHAR(#34+ExtractFileDir(Application.Exename)+'./images/0.bmp'+#34);
  texture_picture2 := PCHAR(#34+ExtractFileDir(Application.Exename)+'./images/0.bmp'+#34);
  texture_picture3 := PCHAR(#34+ExtractFileDir(Application.Exename)+'./images/0.bmp'+#34);
  texture_picture4 := './images/urlaub.bmp';
  lpd3d:=nil;
  lpd3ddevice:=nil;
  lpd3ddevice2:=nil;
  lpd3ddevice3:=nil;
  lpd3ddevice4:=nil;
  CubeVB:=nil;
  CubeVB2:=nil;
  CubeVB3:=nil;
  CubeVB4:=nil;
  CubeTexture:=nil;
  //Initialisiere die Rotation
  RotX:=0;
  RotY:=0;
  RotZ:=0;
  Animate:=false;
  Animate2:=false;
  Animate3:=false;
  Animate4:=false;
  end;

// Fataler Fehler. Meldung und Programmende
procedure TFrmwuerfel3d.FatalError(hr : HResult; FehlerMsg : string);
var
  s : string;
begin
  if hr<>0 then s:=D3DXErrorString(hr)+#13+FehlerMsg else s:=FehlerMsg;
  D3DKillScene(1);
  D3DShutdown(1);
  MessageDlg(s,mtError,[mbOK],0);
  close;
  end;



procedure TFrmwuerfel3d.D3DInit(myphwnd: hwnd; lpd3dD_Nr: Integer);
var
  hr    : HRESULT;
  d3dpp : TD3DPRESENTPARAMETERS;
  mylpd3ddevice : IDirect3DDevice8;
begin

  //Erstelle Direct3D! Muß immer als erstes erstellt werden
  //Immer D3D_SDK_VERSION als Version setzen
  lpd3d:=Direct3DCreate8(D3D_SDK_VERSION);
  lpd3d2:=Direct3DCreate8(D3D_SDK_VERSION);
  lpd3d3:=Direct3DCreate8(D3D_SDK_VERSION);
  lpd3d4:=Direct3DCreate8(D3D_SDK_VERSION);
  if(lpd3d=nil) then FatalError(0,'Fehler beim Erstellen von Direct3D!');

  // Setze D3DPRESENT_PARAMETERS auf 0, sonst könnten wir probleme mit älteren
  // Eintragungen bzw. unkontrollierbaren Ergebnissen bekommen!
  // Sollten wir bei allen DirectX Strukturen machen
  ZeroMemory(@d3dpp,sizeof(d3dpp));

  // Hiermit werden alte Frames gelöscht, denn wir brauchen sie nicht
  with d3dpp do begin
    SwapEffect:=D3DSWAPEFFECT_DISCARD;
    hDeviceWindow:=myphwnd;      // Dies ist unser HWND von TForm
    BackBufferCount:=1;         // 1 Backbuffer

    // Wir brauche einen Z-Buffer also schalten wir ihn ein
    EnableAutoDepthStencil := TRUE;
    AutoDepthStencilFormat := D3DFMT_D16;

    Windowed          := true;
    BackBufferWidth   := 1280;
    BackBufferHeight  := 1024;
    BackBufferFormat  := D3DFMT_X8R8G8B8;
    end;

  //Nachdem wir die D3DPRESENT_PARAMETERS Struktur ausgefüllt haben, sind wir
  // endlich so weit unser D3D Device zu erstellen
   case lpd3dD_Nr of
    1: hr:=lpd3d.CreateDevice(D3DADAPTER_DEFAULT,
                         D3DDEVTYPE_HAL,
                         myphwnd,
                         D3DCREATE_SOFTWARE_VERTEXPROCESSING,
                         d3dpp,
                         lpd3ddevice);
    2: hr:=lpd3d2.CreateDevice(D3DADAPTER_DEFAULT,
                         D3DDEVTYPE_HAL,
                         myphwnd,
                         D3DCREATE_SOFTWARE_VERTEXPROCESSING,
//                         D3DCREATE_HARDWARE_VERTEXPROCESSING,
                         d3dpp,
                         lpd3ddevice2);
    3: hr:=lpd3d3.CreateDevice(D3DADAPTER_DEFAULT,
                         D3DDEVTYPE_HAL,
                         myphwnd,
                         D3DCREATE_SOFTWARE_VERTEXPROCESSING,
//                         D3DCREATE_HARDWARE_VERTEXPROCESSING,
                         d3dpp,
                         lpd3ddevice3);
    4: hr:=lpd3d3.CreateDevice(D3DADAPTER_DEFAULT,
                         D3DDEVTYPE_HAL,
                         myphwnd,
                         D3DCREATE_SOFTWARE_VERTEXPROCESSING,
//                         D3DCREATE_HARDWARE_VERTEXPROCESSING,
                         d3dpp,
                         lpd3ddevice4);
   end;

  if FAILED(hr) then FatalError(hr,'Fehler beim Erzeugen des 3D-Device');
  end;

// *** D3DShutdown hier werden die Resourcen von D3D wieder freigegeben
procedure TFrmwuerfel3d.D3DShutdown(lpd3dD_Nr: Integer);
var
  mylpd3ddevice : IDirect3DDevice8;
begin
  case lpd3dD_Nr of
    1: mylpd3ddevice := lpd3ddevice;
    2: mylpd3ddevice := lpd3ddevice2;
    3: mylpd3ddevice := lpd3ddevice3;
    4: mylpd3ddevice := lpd3ddevice4;
  end;

  if assigned(mylpd3ddevice) then mylpd3ddevice:=nil;
  if assigned(lpd3d) then lpd3d:=nil;
  end;

procedure TFrmwuerfel3d.D3DInitScene(lpd3dD_Nr: Integer);
var
  hr         : HRESULT;
  vbVertices : pByte;
  ViewMatrix,
  matProj    : TD3DXMATRIX;
  mylpd3ddevice: IDirect3DDevice8;
  myCubeTexture: IDIRECT3DTEXTURE8;
  myCubeVB: IDirect3DVertexBuffer8;
begin
  // Hier wird der Vertex Buffer erstellt, der groß genug ist um alle Vertizes zu enthalten.
  case lpd3dD_Nr of
    1: begin
        mylpd3ddevice := lpd3ddevice;
        myCubeTexture := CubeTexture;
        myCubeVB := cubeVB;
       end;
    2: begin
        mylpd3ddevice := lpd3ddevice2;
        myCubeTexture := CubeTexture2;
        myCubeVB := cubeVB2;
       end;
    3: begin
        mylpd3ddevice := lpd3ddevice3;
        myCubeTexture := CubeTexture3;
        myCubeVB := cubeVB3;
       end;
    4: begin
        mylpd3ddevice := lpd3ddevice4;
        myCubeTexture := CubeTexture4;
        myCubeVB := cubeVB4;
       end;
  end;

  if assigned(mylpd3ddevice) then with mylpd3ddevice do begin
    case lpd3dD_Nr of
      1: begin
          hr:=CreateVertexBuffer (sizeof(TCube),
                            D3DUSAGE_WRITEONLY, // Nur Schreibzugriffe
                            D3D8T_CUSTOMVERTEX, // Unser Vertex
                            D3DPOOL_MANAGED,
                            CubeVB);

          if FAILED(hr) then FatalError(0,'Fehler beim Erstellen des Vertex Buffers');

          // Nun kopieren wir unsere Vertizes in den Buffer
          // Wir müssen es zuvor mit Lock festhalten, um es bearbeiten zu können
          with CubeVB do begin
            hr:=Lock(0, // Offset, an dem wir beginnen
                     0, // Größe des locks ( 0 für alles )
                     vbVertices, // Wenn erfolgreich dann hier ablegen
                     0); // sonstige Flags
            if FAILED(hr) then FatalError(0,'Fehler beim Locken des Vertex-Buffers');
            // Hier wird der Vertexbuffer kopiert.
            Move(NormCube,vbVertices^,SizeOf(TCube));
            // Und wieder loslassen
            Unlock;
            end;
          end;
                                         // Pointer zu unserem Buffer
      2: begin
          hr:=CreateVertexBuffer (sizeof(TCube),
                            D3DUSAGE_WRITEONLY, // Nur Schreibzugriffe
                            D3D8T_CUSTOMVERTEX, // Unser Vertex
                            D3DPOOL_MANAGED,
                            CubeVB2);

          if FAILED(hr) then FatalError(0,'Fehler beim Erstellen des Vertex Buffers');

          // Nun kopieren wir unsere Vertizes in den Buffer
          // Wir müssen es zuvor mit Lock festhalten, um es bearbeiten zu können
          with CubeVB2 do begin
            hr:=Lock(0, // Offset, an dem wir beginnen
                     0, // Größe des locks ( 0 für alles )
                     vbVertices, // Wenn erfolgreich dann hier ablegen
                     0); // sonstige Flags
            if FAILED(hr) then FatalError(0,'Fehler beim Locken des Vertex-Buffers');
            // Hier wird der Vertexbuffer kopiert.
            Move(NormCube,vbVertices^,SizeOf(TCube));
            // Und wieder loslassen
            Unlock;
            end;
          end;
                                          // Pointer zu unserem Buffer
      3: begin
          hr:=CreateVertexBuffer (sizeof(TCube),
                            D3DUSAGE_WRITEONLY, // Nur Schreibzugriffe
                            D3D8T_CUSTOMVERTEX, // Unser Vertex
                            D3DPOOL_MANAGED,
                            CubeVB3);

          if FAILED(hr) then FatalError(0,'Fehler beim Erstellen des Vertex Buffers');

          // Nun kopieren wir unsere Vertizes in den Buffer
          // Wir müssen es zuvor mit Lock festhalten, um es bearbeiten zu können
          with CubeVB3 do begin
            hr:=Lock(0, // Offset, an dem wir beginnen
                     0, // Größe des locks ( 0 für alles )
                     vbVertices, // Wenn erfolgreich dann hier ablegen
                     0); // sonstige Flags
            if FAILED(hr) then FatalError(0,'Fehler beim Locken des Vertex-Buffers');
            // Hier wird der Vertexbuffer kopiert.
            Move(NormCube,vbVertices^,SizeOf(TCube));
            // Und wieder loslassen
            Unlock;
            end;
         end;          // Pointer zu unserem Buffer
                                          // Pointer zu unserem Buffer
      4: begin
          hr:=CreateVertexBuffer (sizeof(TCube),
                            D3DUSAGE_WRITEONLY, // Nur Schreibzugriffe
                            D3D8T_CUSTOMVERTEX, // Unser Vertex
                            D3DPOOL_MANAGED,
                            CubeVB4);

          if FAILED(hr) then FatalError(0,'Fehler beim Erstellen des Vertex Buffers');

          // Nun kopieren wir unsere Vertizes in den Buffer
          // Wir müssen es zuvor mit Lock festhalten, um es bearbeiten zu können
          with CubeVB4 do begin
            hr:=Lock(0, // Offset, an dem wir beginnen
                     0, // Größe des locks ( 0 für alles )
                     vbVertices, // Wenn erfolgreich dann hier ablegen
                     0); // sonstige Flags
            if FAILED(hr) then FatalError(0,'Fehler beim Locken des Vertex-Buffers');
            // Hier wird der Vertexbuffer kopiert.
            Move(NormCube,vbVertices^,SizeOf(TCube));
            // Und wieder loslassen
            Unlock;
            end;
         end;          // Pointer zu unserem Buffer
    end;

    SetRenderState(D3DRS_CULLMODE,D3DCULL_CCW);
    SetRenderState(D3DRS_LIGHTING,0);
    SetRenderState(D3DRS_ZENABLE,0);

    // Hier erstellen wir unseren SichtMatrix. Denkt einfach es ist
    // eure Kamera, von der aus wir sehen. Als erstes setzen wir die Kamera
    // um 8 Einheiten zurück auf der Z-Achse.
    D3DXMatrixLookAtLH (ViewMatrix,D3DXVECTOR3(0.0,0.0,-8.0),
                                   D3DXVECTOR3(0.0,0.0,0.0),
                                   D3DXVECTOR3(0.0,1.0,0.0));

    // Da sich unsere Camera nicht bewegt legen wir sie einfach fest
    SetTransform(D3DTS_VIEW,ViewMatrix);

    D3DXMatrixPerspectiveFovLH(matProj, //Resultierende Matrix
                               D3DX_PI/4,//Radius der Ansicht
                               640/480,
                               1.0,     // Mindeste Nähe
                               100.0);  // Maximal sichtbare Entfernung

    // Unsere Projektion wird sich niemals bewegen, also setzen wir sie fest
    SetTransform(D3DTS_PROJECTION,matProj );

    // Mit D3DTSS_COLLORP wird festgelegt, wie die Farbe jedes einzelnen Pixels
    // verarbeitet wird. D3DTOP_SELECTARG1 verweist auf D3DTSS_COLORARG1
    SetTextureStageState(0,D3DTSS_COLOROP, D3DTOP_SELECTARG1);
    // Mit D3DTSS_COLORARG1 wird festgelegt, daß die Farbe nur von der Textur
    // genommen wird und von nichts anderem.
    SetTextureStageState(0,D3DTSS_COLORARG1, D3DTA_TEXTURE);
    // Wir benutzen kein Alpha blending, also schalten wir es ab. Dadurch wird
    // der Code etwas schneller
    SetTextureStageState(0,D3DTSS_ALPHAOP,   D3DTOP_DISABLE);
    // MAGFILTER ist dafür, wenn es kleiner ist als unser Objekt.
    // MINFILTER ist genau das umgekehrte
    // Standard ist D3DTEXF_LINEAR. Dieses ist zwar langsamer als D3DTEXF_POINT,
    // sieht aber besser aus.
    SetTextureStageState(0,D3DTSS_MAGFILTER, D3DTEXF_LINEAR);
    SetTextureStageState(0,D3DTSS_MINFILTER, D3DTEXF_LINEAR);

    // Ich glaube diese Funktion bräuchte ich nicht zu beschreiben, aber hier
    // wird die Textur geladen.

    case lpd3dD_Nr of
      1: hr:=D3DXCreateTextureFromFile(lpd3ddevice,texture_picture, CubeTexture);
      2: hr:=D3DXCreateTextureFromFile(lpd3ddevice2,texture_picture2, CubeTexture2);
      3: hr:=D3DXCreateTextureFromFile(lpd3ddevice3,texture_picture3, CubeTexture3);
      4: hr:=D3DXCreateTextureFromFile(lpd3ddevice4,texture_picture4, CubeTexture4);
    end;

    if(FAILED(hr)) then FatalError(0,'Fehler beim Laden der Textur');
    end;
  case lpd3dD_Nr of
    1: Animate:=true;
    2: Animate2:=true;
    3: Animate3:=true;
    4: Animate4:=true;
  end;

  end;

procedure TFrmwuerfel3d.D3DKillScene(lpd3dD_Nr: Integer);
begin

    case lpd3dD_Nr of
      1: CubeVB:=nil;
      2: CubeVB2:=nil;
      3: CubeVB3:=nil;
      4: CubeVB4:=nil;
    end;

end;

procedure TFrmwuerfel3d.D3DRender(lpd3dD_Nr: Integer);
var
  WorldMatrix,TempMatrix  : TD3DXMATRIX;
  mylpd3ddevice: IDirect3DDevice8;
  myCubeTexture: IDIRECT3DTEXTURE8;
  myCubeVB: IDirect3DVertexBuffer8;
  myColor: TColor;
begin
  RotY:=RotY+0.0065;
  RotX:=RotX+0.007;
  RotZ:=RotZ+0.006;

  myColor := unit1.colorBG;
  if frmPanelStock.AdvSmoothSlider2.State = ssOn then
    myColor := D3DCOLOR_XRGB(255, 255, 255)
  else
    myColor := D3DCOLOR_XRGB(68, 128, 176);

  //form1.Color := myColor;
  case lpd3dD_Nr of
    1: begin
        mylpd3ddevice := lpd3ddevice;
        myCubeTexture := CubeTexture;
        myCubeVB := cubeVB;

        if assigned(lpd3ddevice) then with lpd3ddevice do
        begin
          Clear(0,           // Wieviel Rechtecke löschen? 0 Löscht alle
                nil,         // Pointer zu den Rechtecken. nil = Ganzer Bildschirm
                D3DCLEAR_TARGET,
                //D3DCOLOR_ARGB(255,70,125,176), //Hintergrundfarbe schwarz
                myColor,
                1,           // Lösche ZBuffer ( Wir haben momentan noch keinen )
                0 );

         SetRenderState(D3DRS_ALPHABLENDENABLE, 1);
         {SetRenderState(D3DRS_SRCBLEND, Integer(D3DBLEND_srcalpha));
         SetRenderState(D3DRS_DESTBLEND, Integer(D3DBLEND_invsrccolor));
         SetRenderState(D3DRS_CULLMODE, Ord(D3DCULL_none));

         SetRenderState(D3DRS_ZWRITEENABLE, Ord(false));     }

          if SUCCEEDED(BeginScene) then
          begin
            // Hier wird unsere Textur geladen
            SetTexture(0, CubeTexture);

            // Vertex Shader sind wirklich komplex, aber es lassen sich damit gute Effekte
            // erzielen. Genauere Beschreibungen in der SDK, denn alles hier niederschreiben
            // sprengt den Rahmen eines Tutorials
            SetVertexShader(D3D8T_CUSTOMVERTEX);

            // Die D3D Renderfunktionen lesen aus Streams. Hier sagen wir DX welchen Stream
            // es verwenden soll
            SetStreamSource(0,CubeVB,sizeof(TMyVertex));

            // Die Rotation um alle Achsen.
            D3DXMatrixRotationYawPitchRoll(TempMatrix,RotY,RotX,RotZ);
            // Verschiebe den Würfel etwas nach vorn
            D3DXMatrixTranslation(WorldMatrix,0.0,0.0,-2.0);
            // Berechne die Welt-Matrix für die Transformation
            D3DXMatrixMultiply(WorldMatrix,TempMatrix,WorldMatrix);
            SetTransform(D3DTS_WORLD,WorldMatrix);

            // Zeichnen des Würfels
            DrawPrimitive(D3DPT_TRIANGLELIST,0,12);

            EndScene;
          end;

        // Zeige Resultate auf dem Bildschirm
        Present(nil,nil,0,nil);
      end;
       end;
    2: begin
        mylpd3ddevice := lpd3ddevice2;
        myCubeTexture := CubeTexture2;
        myCubeVB := cubeVB2;

        if assigned(lpd3ddevice2) then with lpd3ddevice2 do
        begin
          Clear(0,           // Wieviel Rechtecke löschen? 0 Löscht alle
                nil,         // Pointer zu den Rechtecken. nil = Ganzer Bildschirm
                D3DCLEAR_TARGET,
                myColor,//D3DCOLOR_ARGB(255,65,123,170), //Hintergrundfarbe schwarz
                1,           // Lösche ZBuffer ( Wir haben momentan noch keinen )
                0 );

          if SUCCEEDED(BeginScene) then
          begin
            // Hier wird unsere Textur geladen
            SetTexture(0, CubeTexture2);

            // Vertex Shader sind wirklich komplex, aber es lassen sich damit gute Effekte
            // erzielen. Genauere Beschreibungen in der SDK, denn alles hier niederschreiben
            // sprengt den Rahmen eines Tutorials
            SetVertexShader(D3D8T_CUSTOMVERTEX);

            // Die D3D Renderfunktionen lesen aus Streams. Hier sagen wir DX welchen Stream
            // es verwenden soll
            SetStreamSource(0,CubeVB2,sizeof(TMyVertex));

            // Die Rotation um alle Achsen.
            D3DXMatrixRotationYawPitchRoll(TempMatrix,RotY,RotX,RotZ);
            // Verschiebe den Würfel etwas nach vorn
            D3DXMatrixTranslation(WorldMatrix,0.0,0.0,-2.0);
            // Berechne die Welt-Matrix für die Transformation
            D3DXMatrixMultiply(WorldMatrix,TempMatrix,WorldMatrix);
            SetTransform(D3DTS_WORLD,WorldMatrix);

            // Zeichnen des Würfels
            DrawPrimitive(D3DPT_TRIANGLELIST,0,12);

            EndScene;
          end;
        // Zeige Resultate auf dem Bildschirm
        Present(nil,nil,0,nil);
      end;
       end;
    3: begin
        mylpd3ddevice := lpd3ddevice3;
        myCubeTexture := CubeTexture3;
        myCubeVB := cubeVB3;

        if assigned(lpd3ddevice3) then with lpd3ddevice3 do
        begin
          Clear(0,           // Wieviel Rechtecke löschen? 0 Löscht alle
                nil,         // Pointer zu den Rechtecken. nil = Ganzer Bildschirm
                D3DCLEAR_TARGET,
                myColor,
                1,           // Lösche ZBuffer ( Wir haben momentan noch keinen )
                0 );

          if SUCCEEDED(BeginScene) then
          begin
            // Hier wird unsere Textur geladen
            SetTexture(0, CubeTexture3);

            // Vertex Shader sind wirklich komplex, aber es lassen sich damit gute Effekte
            // erzielen. Genauere Beschreibungen in der SDK, denn alles hier niederschreiben
            // sprengt den Rahmen eines Tutorials
            SetVertexShader(D3D8T_CUSTOMVERTEX);

            // Die D3D Renderfunktionen lesen aus Streams. Hier sagen wir DX welchen Stream
            // es verwenden soll
            SetStreamSource(0,CubeVB3,sizeof(TMyVertex));

            // Die Rotation um alle Achsen.
            D3DXMatrixRotationYawPitchRoll(TempMatrix,RotY,RotX,RotZ);
            // Verschiebe den Würfel etwas nach vorn
            D3DXMatrixTranslation(WorldMatrix,0.0,0.0,-2.0);
            // Berechne die Welt-Matrix für die Transformation
            D3DXMatrixMultiply(WorldMatrix,TempMatrix,WorldMatrix);
            SetTransform(D3DTS_WORLD,WorldMatrix);

            // Zeichnen des Würfels
            DrawPrimitive(D3DPT_TRIANGLELIST,0,12);

            EndScene;
          end;
        // Zeige Resultate auf dem Bildschirm
        Present(nil,nil,0,nil);
      end;
    end;
    4: begin
        mylpd3ddevice := lpd3ddevice4;
        myCubeTexture := CubeTexture4;
        myCubeVB := cubeVB4;

        if assigned(lpd3ddevice4) then with lpd3ddevice4 do
        begin
          Clear(0,           // Wieviel Rechtecke löschen? 0 Löscht alle
                nil,         // Pointer zu den Rechtecken. nil = Ganzer Bildschirm
                D3DCLEAR_TARGET,
                D3DCOLOR_XRGB(220,234,249), //Hintergrundfarbe schwarz
                1,           // Lösche ZBuffer ( Wir haben momentan noch keinen )
                0 );

          if SUCCEEDED(BeginScene) then
          begin
            // Hier wird unsere Textur geladen
            SetTexture(0, CubeTexture4);

            // Vertex Shader sind wirklich komplex, aber es lassen sich damit gute Effekte
            // erzielen. Genauere Beschreibungen in der SDK, denn alles hier niederschreiben
            // sprengt den Rahmen eines Tutorials
            SetVertexShader(D3D8T_CUSTOMVERTEX);

            // Die D3D Renderfunktionen lesen aus Streams. Hier sagen wir DX welchen Stream
            // es verwenden soll
            SetStreamSource(0,CubeVB4,sizeof(TMyVertex));

            // Die Rotation um alle Achsen.
            D3DXMatrixRotationYawPitchRoll(TempMatrix,RotY,RotX,RotZ);
            // Verschiebe den Würfel etwas nach vorn
            D3DXMatrixTranslation(WorldMatrix,0.0,0.0,-2.0);
            // Berechne die Welt-Matrix für die Transformation
            D3DXMatrixMultiply(WorldMatrix,TempMatrix,WorldMatrix);
            SetTransform(D3DTS_WORLD,WorldMatrix);

            // Zeichnen des Würfels
            DrawPrimitive(D3DPT_TRIANGLELIST,0,12);

            EndScene;
          end;
        // Zeige Resultate auf dem Bildschirm
        Present(nil,nil,0,nil);
      end;
    end;

  end;



  end;



procedure TFrmwuerfel3d.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  // Lösche die D3D Scene bevor wir D3D beenden
  D3DKillScene(1);
  // Lösche D3D
  D3DShutdown(1);
  end;

procedure TFrmwuerfel3d.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key=VK_ESCAPE then close;
  if Key=VK_SPACE then Animate:=not Animate;
  end;



procedure TFrmwuerfel3d.timerWuerfel3DTimer(Sender: TObject);
begin
  if wuerfel3D.Animate then
    frmWuerfel3D.D3DRender(1);

  if wuerfel3D.Animate2 then
    frmWuerfel3D.D3DRender(2);

  if wuerfel3D.Animate3 then
    frmWuerfel3D.D3DRender(3);
end;

end.