unit test1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,
OpenGL, ExtCtrls;
type
TForm1 =
class(TForm)
t_Main: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure t_MainTimer(Sender: TObject);
private
{ Private declarations }
myDC : HDC;
myRC : HGLRC;
myPalette : HPALETTE;
procedure SetupPixelFormat;
public
{ Public declarations }
end;
procedure Render;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
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
// zwischengespeiichert
begin
FillChar(pfd, SizeOf(pfd), 0);
with pfd
do begin //wir woollen 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 (Anzahl der Farben)
cDepthBits:= 32;
// 32-bit depth buffer
iLayerType:= PFD_MAIN_PLANE;
// Layer Type
end;
nPixelFormat:= ChoosePixelFormat(myDC, @pfd);
//Das Pixel-Format
SetPixelFormat(myDC, nPixelFormat, @pfd);
// wird übertragen
// Farbpalettenoptimierung wenn erforderlich
DescribePixelFormat(myDC, nPixelFormat,
//alles ab hier ist zwecks einstellungen nicht
//mehr wichtig, sondern schlicht und einfach nur noch notwendig... ;-)
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);
glLoadIdentity;
Glbegin(gl_quads);
//wir wollen ein Viereck zeichnen
glVertex3f( 1 , 1,-6);
glVertex3f(-1 , 1,-6);
glVertex3f(-1 ,-1,-6);
glVertex3f( 1 ,-1,-6);
glend;
SwapBuffers(form1.myDC);
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.FormResize(Sender: TObject);
begin
glViewport(0, 0, Width, Height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluPerspective(45.0, Width/Height, 1.0, 100.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity();
end;
procedure TForm1.t_MainTimer(Sender: TObject);
begin
render;
end;
end.