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:
| unit FrmCube1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, opengl, StdCtrls;
type TfrmCube = class(TForm) procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormPaint(Sender: TObject); procedure FormDestroy(Sender: TObject); private hrc: HGLRC; DC : hdc; procedure DrawScene; public end;
const tex : array[0..1, 0..7, 0..7] of GLubyte = (((0, 0, 0, 0, 0, 0, 0, 0), (0, 0, 0, 0, 1, 0, 0, 0), (0, 0, 0, 1, 1, 0, 0, 0), (0, 0, 0, 0, 1, 0, 0, 0), (0, 0, 0, 0, 1, 0, 0, 0), (0, 0, 0, 0, 1, 0, 0, 0), (0, 0, 0, 1, 1, 1, 0, 0), (0, 0, 0, 0, 0, 0, 0, 0)),
((0, 0, 0, 0, 0, 0, 0, 0), (0, 0, 0, 2, 2, 0, 0, 0), (0, 0, 2, 0, 0, 2, 0, 0), (0, 0, 0, 0, 0, 2, 0, 0), (0, 0, 0, 0, 2, 0, 0, 0), (0, 0, 0, 2, 0, 0, 0, 0), (0, 0, 2, 2, 2, 2, 0, 0), (0, 0, 0, 0, 0, 0, 0, 0)));
type ttex = Array[0..63, 0..2] of GLubyte; var t : Array[0..2] of ttex;
frmCube : TfrmCube; Distanz : Real; winkel1 : Integer; winkel2 : Integer; winkel3 : Integer;
implementation
{$R *.DFM}
procedure Init_Texturen; var p, i, j : Integer; const width = 8; height = 8; begin for i := 0 to height - 1 do begin for j := 0 to width - 1 do begin p := i * width + j; t[0][p, 0] := $FF; t[0][p, 1] := 0; if tex[0][i, j] = 0 then t[0][p, 2] := $FF else t[0][p, 2] := 0; t[1][p, 0] := $FF; t[1][p, 1] := $FF; if tex[1][i, j] = 0 then t[1][p, 2] := $FF else t[1][p, 2] := 0; end; end; end;
procedure SetDCPixelFormat(Handle: HDC); var pfd: TPixelFormatDescriptor; nPixelFormat: Integer; 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(Handle, @pfd); SetPixelFormat(Handle, nPixelFormat, @pfd); end;
procedure TfrmCube.DrawScene; begin glNewList(11, GL_COMPILE); glBegin( GL_QUADS ); glTexCoord2f( 0.0, 0.0 ); glVertex2f( -1, 1 ); glTexCoord2f( 1.0, 0.0 ); glVertex2f( 1, 1 ); glTexCoord2f( 1.0, 1.0 ); glVertex2f( 1, -1 ); glTexCoord2f( 0.0, 1.0 ); glVertex2f( -1, -1 ); glEnd; glEndList;
glEnable(GL_DEPTH_TEST); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); glMatrixMode(GL_MODELVIEW); glDepthFunc( GL_LEQUAL );
glLoadIdentity;
glEnable( GL_TEXTURE_2D ); glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT); glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
glTranslatef(0, 0, Distanz); glRotatef(winkel1, 1, 0, 0); glRotatef(winkel2, 0, 1, 0); glRotatef(winkel3, 0, 0, 1);
glTranslatef(0, 0, 1.0); glTexImage2D(GL_TEXTURE_2D, 0, 3, 8, 8, 0, GL_RGB, GL_UNSIGNED_BYTE, @t[0]); glCallList(11); glTranslatef(0, 0, -2.0); glTexImage2D(GL_TEXTURE_2D, 0, 3, 8, 8, 0, GL_RGB, GL_UNSIGNED_BYTE, @t[1]); glCallList(11);
SwapBuffers(DC); end;
procedure TfrmCube.FormCreate(Sender: TObject); begin DC := GetDC(Handle); Randomize; SetDCPixelFormat(Canvas.Handle); hrc := wglCreateContext(Canvas.Handle); Winkel1 := 30; Winkel2 := 30; Winkel3 := 30; Distanz := -10; Init_Texturen; end;
procedure TfrmCube.FormResize(Sender: TObject); begin wglMakeCurrent(DC, hrc); glMatrixMode(GL_PROJECTION); glLoadIdentity; gluPerspective(30.0, Width / Height, 1.0, 50.0); glViewport(0, 0, Width, Height); wglMakeCurrent(0, 0); Invalidate; end;
procedure TfrmCube.FormPaint(Sender: TObject); begin wglMakeCurrent(DC, hrc); DrawScene; wglMakeCurrent(0, 0); end;
procedure TfrmCube.FormDestroy(Sender: TObject); begin wglDeleteContext(hrc); ReleaseDC(Handle, DC); end;
end. |