- unit Unit1;
- interface
- uses
- Windows,opengl, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs;
- type
- TForm1 = class(TForm)
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormPaint(Sender: TObject);
- procedure FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- private
- mydc : HDC;
- myrc : HGLRC;
- myPalette : HPALETTE;
- procedure SetupPixelFormat;
- { Private-Deklarationen }
- public
- { Public-Deklarationen }
- end;
- var
- Form1: TForm1;rotx,roty:integer;
- implementation
- {$R *.dfm}
- procedure Tform1.SetupPixelFormat;
- var
- hheap : Thandle;
- ncolors,i : integer;
- lppalette : plogpalette;
- byredmask, bygreenmask, bybluemask : byte;
- npixelformat : integer;
- pfd : Tpixelformatdescriptor;
- begin
- Fillchar(pfd,sizeof(pfd),0);
- with pfd do
- begin
- nsize := sizeof(pfd);
- nversion := 1;
- dwflags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
- ipixeltype := PFD_TYPE_RGBA;
- cColorbits := 24;
- cdepthbits := 32;
- ilayertype := PFD_Main_Plane;
- end;
- nPixelFormat:= ChoosePixelFormat(myDC, @pfd);
- SetPixelFormat(myDC, nPixelFormat, @pfd);
- 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 Objekt;
- begin
- glClearColor(0, 0, 0.0, 1); // HintergundFarbe
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); //Farb und Tiefenpuffer löschen
- glMatrixMode(GL_PROJECTION); // Darstellungsmodus = Projektionsmodus
- glLoadIdentity;
- glPolygonMode(GL_FRONT, GL_FILL); // Nur Vorderseiten darstellen (schneller) / Füllmodus : gefüllte Objekte
- glMatrixMode(GL_MODELVIEW); // Koordinatensystem drehen
- glLoadIdentity; // Setzt alles zurück auf Uhrsprungspunkt(sehr wichtig!)-ansonsten wird die Scene irgendwo dargestellt, aber nicht da, wo sie hin soll
- glPushmatrix();
- glcolor3f(1,1,0);
- glrotate(rotx,1,0,0);
- glrotate(roty,0,1,0);
- glBegin(GL_QUADS); //dieser Befehl zeichnet einen Würfel.
- glVertex3d(0.5, -0.5, 0.5); //Linke Seite
- glVertex3d(-0.5, -0.5, 0.5);
- glVertex3d(-0.5, -0.5, -0.5);
- glVertex3d(0.5, -0.5, -0.5);
- glVertex3d(-0.5, -0.5, -0.5); //Rückseite
- glVertex3d(-0.5, 0.5, -0.5);
- glVertex3d(0.5, 0.5, -0.5);
- glVertex3d(0.5, -0.5, -0.5);
- glVertex3d(0.5, -0.5, -0.5); //Oberseite
- glVertex3d(0.5, 0.5, -0.5);
- glVertex3d(0.5, 0.5, 0.5);
- glVertex3d(0.5, -0.5, 0.5);
- glVertex3d(-0.5, -0.5, 0.5); //Vorderseite
- glVertex3d(-0.5, 0.5, 0.5);
- glVertex3d(0.5, 0.5, 0.5);
- glVertex3d(0.5, -0.5, 0.5);
- glVertex3d(-0.5, -0.5, 0.5); //Boden / Unterseite
- glVertex3d(-0.5, 0.5, 0.5);
- glVertex3d(-0.5, 0.5, -0.5);
- glVertex3d(-0.5, -0.5, -0.5);
- glVertex3d(-0.5, 0.5, 0.5); //Rechte Seite
- glVertex3d(0.5, 0.5, 0.5);
- glVertex3d(0.5, 0.5, -0.5);
- glVertex3d(-0.5, 0.5, -0.5);
- glEnd();
- SwapBuffers(form1.myDC); //scene darstellen
- end;
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- form1.myDC:= GetDC(Handle);
- SetupPixelFormat;
- myRC:= wglCreateContext(myDC);
- wglMakeCurrent(myDC, myRC);
- glEnable(GL_DEPTH_TEST);
- glLoadIdentity;
- end;
- procedure TForm1.FormDestroy(Sender: TObject);
- begin
- wglmakecurrent(0,0);
- wgldeletecontext(mydc);
- releasedc(handle,mydc);
- end;
- procedure TForm1.FormPaint(Sender: TObject);
- begin
- objekt;
- end;
- procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- begin
- if key = vk_down then
- begin
- rotx := rotx+1;
- end;
- if key = vk_up then
- begin
- rotx := rotx-1;
- end;
- if key = vk_right then
- begin
- roty := roty+1;
- end;
- if key = vk_left then
- begin
- roty := roty-1;
- end;
- repaint;
- end;
- end.