- unit Unit1;
- interface
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, opengl,
- ExtCtrls, StdCtrls;
- type
- TForm1 = class(TForm)
- Timer1: TTimer;
- procedure Timer1Timer(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- private
- myDC : HDC;
- myRC : HGLRC;
- myPalette : HPALETTE;
- procedure SetupPixelFormat;
- public
- { Public declarations }
- end;
- var
- Form1: TForm1;
- right: integer;
- implementation
- {$R *.DFM}
- PROCEDURE glGenTextures(n: GLsizei; VAR textures: GLuint); STDCALL; EXTERNAL opengl32;
- PROCEDURE glBindTexture(target: GLenum; texture: GLuint); STDCALL; EXTERNAL opengl32;
- 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); // 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 TForm1.FormCreate(Sender: TObject);
- begin
- Form1.myDC:= GetDC(form1.Handle);
- SetupPixelFormat;
- myRC:= wglCreateContext(myDC);
- wglMakeCurrent(myDC, myRC);
- glEnable(GL_DEPTH_TEST);
- glenable(gl_texture_2d);
- glLoadIdentity;
- end;
- procedure TForm1.FormDestroy(Sender: TObject);
- begin
- wglmakecurrent(0,0);
- wgldeletecontext(mydc);
- releasedc(handle,mydc);
- end;
- procedure render;
- begin
- glClearColor(0.5,0.5,0.5,0.5);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- glLoadIdentity;
- glMatrixMode(gl_modelview);
- glbegin(gl_quads);
- glcolor3f(1,0,0);
- glvertex3f(-1,-1,-1);
- glcolor3f(0,1,0);
- glvertex3f(1,-1,-1);
- glcolor3f(0,0,1);
- glvertex3f(1,1,-1);
- glcolor3f(1,1,0);
- glvertex3f(-1,1,-1);
- glEnd();
- glbegin(gl_quads);
- glcolor3f(1,0,0);
- glvertex3f(-1,-1,-1.5);
- glcolor3f(0,1,0);
- glvertex3f(1,-1,-1.5);
- glcolor3f(0,0,1);
- glvertex3f(1,1,-1.5);
- glcolor3f(1,1,0);
- glvertex3f(-1,1,-1.5);
- glEnd();
- SwapBuffers(form1.myDC);
- end;
- procedure TForm1.Timer1Timer(Sender: TObject);
- begin
- render;
- end;
- end.