1:
2:
3:
4:

if VK_UP then
begin
 model:=y+1;
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:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, opengl,
  ExtCtrls, gl3ds;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
   myDC : HDC;
   myRC : HGLRC;
   myPalette : HPALETTE;
   procedure SetupPixelFormat;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  model: TAll3dsMesh;

implementation

{$R *.DFM}
procedure TForm1.SetupPixelFormat;
var    hHeap: THandle;
  nColors, i: Integer;                      //Anzahl der Farben
  lpPalette : PLogPalette;                  //Die Farbpalette
  byRedMask, byGreenMask, byBlueMask: Byte; //Blau, Grün und Rot
  nPixelFormat: Integer;
  pfd: TPixelFormatDescriptor;              //Dies ist der "Descriptor"..in ihm werden die Infos
                                            //zwischengespeichert
begin
  FillChar(pfd, SizeOf(pfd), 0);
  with pfd do begin                         //wir wollen das Format bearbeiten
    nSize     := sizeof(pfd);               // Länge der pfd-Struktur
    nVersion  := 1;                         // Version
    dwFlags   := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or
                 PFD_DOUBLEBUFFER;          // Flags
    iPixelType:= PFD_TYPE_RGBA;             // RGBA Pixel Type
    cColorBits:= 24;                        // 24-bit color
    cDepthBits:= 32;                        // 32-bit depth buffer
    iLayerType:= PFD_MAIN_PLANE;            // Layer Type
  end;
  nPixelFormat:= ChoosePixelFormat(myDC, @pfd);
  SetPixelFormat(myDC, nPixelFormat, @pfd);
                                            // Farbpalettenoptimierung wenn erforderlich
  DescribePixelFormat(myDC, nPixelFormat,
                      sizeof(TPixelFormatDescriptor),pfd);
  if ((pfd.dwFlags and PFD_NEED_PALETTE) <> 0) then begin
    nColors  := 1 shl pfd.cColorBits;
    hHeap    := GetProcessHeap;
    lpPalette:= HeapAlloc
       (hHeap,0,sizeof(TLogPalette)+(nColors*sizeof(TPaletteEntry)));
    lpPalette^.palVersion := $300;
    lpPalette^.palNumEntries := nColors;
    byRedMask  := (1 shl pfd.cRedBits) - 1;
    byGreenMask:= (1 shl pfd.cGreenBits) - 1;
    byBlueMask := (1 shl pfd.cBlueBits) - 1;
    for i := 0 to nColors - 1 do begin
      lpPalette^.palPalEntry[i].peRed  :=
        (((i shr pfd.cRedShift)  and byRedMask)  *255)DIV byRedMask;
      lpPalette^.palPalEntry[i].peGreen:=
        (((i shr pfd.cGreenShift)and byGreenMask)*255)DIV byGreenMask;
      lpPalette^.palPalEntry[i].peBlue :=
        (((i shr pfd.cBlueShift) and byBlueMask) *255)DIV byBlueMask;
      lpPalette^.palPalEntry[i].peFlags:= 0;
    end;
    myPalette:= CreatePalette(lpPalette^);
    HeapFree(hHeap, 0, lpPalette);
    if (myPalette <> 0) then begin
      SelectPalette(myDC, myPalette, False);
      RealizePalette(myDC);
    end;
  end;
end;

procedure render;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); //Farb und Tiefenpuffer löschen
glLoadIdentity;                                      // World Matrix zurücksetzen

gltranslatef(0,0,-12);
glrotatef(90,0,1,0);
glscalef(0.1,0.1,0.1);
model.Render;

SwapBuffers(form1.myDC);                             //scene ausgeben
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
form1.myDC:= GetDC(Handle);
SetupPixelFormat;
myRC:= wglCreateContext(myDC);
wglMakeCurrent(myDC, myRC);
glEnable(GL_DEPTH_TEST);
glLoadIdentity;

model:=TAll3DSMesh.Create(nil);
model.TexturePath:='textur\Tex.bmp';
model.LoadFromFile('teekanne.3ds');

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

model.Free;

wglmakecurrent(0,0);
wgldeletecontext(mydc);
releasedc(handle,mydc);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
glViewport(0, 0, Width, Height);    // Setzt den Viewport für das OpenGL Fenster
glMatrixMode(GL_PROJECTION);        // Matrix Mode auf Projection setzen
glLoadIdentity();                   // Reset View
gluPerspective(45.0, Width/Height, 1, 100.0);  // Perspektive den neuen Maßen anpassen.
glMatrixMode(GL_MODELVIEW);         // Zurück zur Modelview Matrix
glLoadIdentity();
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
render;
end;

end.