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: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, opengl, StdCtrls, glBitmap, ExtCtrls;
type TForm1 = class(TForm) Timer1: TTimer; procedure FormResize(Sender: TObject);
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; fTexture: TglBitmap2D; procedure SetupPixelFormat; procedure Objekt;
public end;
var Form1: TForm1; rotx : integer; 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 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.Objekt; begin glClearColor(0, 0, 0.0, 1); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); glMatrixMode(GL_PROJECTION); glLoadIdentity; glPolygonMode(GL_FRONT, GL_FILL); glMatrixMode(GL_MODELVIEW); glLoadIdentity; glPushmatrix(); glcolor3f(1,1,0); glrotate(rotx,1,0,0); glrotate(roty,0,1,0); glMatrixMode(GL_MODELVIEW); glLoadIdentity(); fTexture.Bind; glBegin(GL_QUADS); 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); glcolor3f(1,0,0); 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); glcolor3f(1,0,1); 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); glcolor3f(0,1,0); 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); glcolor3f(1,0.5,0); 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); glcolor3f(0,0,1); 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);
fTexture := TglBitmap2D.Create; fTexture.LoadFromFile('C:\Dokumente und Einstellungen\Mein_Name\Eigene Dateien\Eigene Bilder\test tztur.bmp'); fTexture.GenTexture; glEnd(); SwapBuffers(form1.myDC);
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;
procedure TForm1.FormResize(Sender: TObject); begin glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION); glLoadIdentity();
gluPerspective(45.0, ClientWidth / ClientHeight, 2.0, 128.0); end;
end. |