ANDREY.EXE » 29.03.2006 19:15:01
{$mode delphi}{$H+}
program Project2;
uses
Windows,
Messages,
glu,
GL;
const
WND_TITLE = 'OpenGL';
FPS_TIMER = 1;
FPS_INTERVAL = 1000;
var
h_Wnd : HWND;
h_DC : HDC;
h_RC : HGLRC;
keys : Array[0..255] of Boolean;
FPSCount : Integer = 0;
ElapsedTime : Integer;
rtri: GLfloat;
rquad: GLfloat;
{$R *.RES}
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;
function IntToStr(Num : Integer) : String;
begin
Str(Num, result);
end;
procedure glDraw();
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity();
glTranslatef(-1.5,0.0,-7.0);
glRotatef(rtri,0.0,1.0,0.0);
glColor3f(0.0,1.0,0.0);
glBegin(GL_POLYGON);
glVertex3f( 0.0, 1.0, 0.0);
glVertex3f(-1.0,-1.0, 0.0);
glVertex3f( 1.0,-1.0, 0.0);
glEnd();
glLoadIdentity();
glTranslatef(1.5,0.0,-6.0);
glRotatef(rquad,1.0,1.0,1.0);
glBegin(GL_QUADS);
glColor3f(0.0,1.0,0.0);
glVertex3f(-1.0, 1.0, 0.0);
glColor3f(1.0,1.0,1.0);
glVertex3f( 1.0, 1.0, 0.0);
glColor3f(1.0,0.0,1.0);
glVertex3f( 1.0,-1.0, 0.0);
glColor3f(0.0,0.0,1.0);
glVertex3f(-1.0,-1.0, 0.0);
glEnd();
rtri := rtri + 0.2;
rquad := rquad - 0.15;
end;
procedure glInit();
begin
glClearColor(0.0, 0.0, 0.0, 0.0);
glShadeModel(GL_SMOOTH);
glClearDepth(1.0);
glEnable(GL_DEPTH_TEST);
glDepthFunc(GL_LESS);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
end;
procedure glResizeWnd(Width, Height : Integer);
begin
if (Height = 0) then
Height := 1;
glViewport(0, 0, Width, Height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
gluPerspective(45.0, Width/Height, 1.0, 100.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity();
end;
function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case (Msg) of
WM_CREATE:
begin
end;
WM_CLOSE:
begin
PostQuitMessage(0);
Result := 0
end;
WM_KEYDOWN:
begin
keys[wParam] := True;
Result := 0;
end;
WM_KEYUP:
begin
keys[wParam] := False;
Result := 0;
end;
WM_SIZE:
begin
glResizeWnd(LOWORD(lParam),HIWORD(lParam));
Result := 0;
end;
WM_TIMER :
begin
if wParam = FPS_TIMER then
begin
FPSCount :=Round(FPSCount * 1000/FPS_INTERVAL);
SetWindowText(h_Wnd, PChar(WND_TITLE + ' [' + intToStr(FPSCount) + ' FPS]'));
FPSCount := 0;
Result := 0;
end;
end;
else
Result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;
end;
procedure glKillWnd(Fullscreen : Boolean);
begin
if Fullscreen then
begin
ChangeDisplaySettings(devmode(nil^), 0);
ShowCursor(True);
end;
if (not wglMakeCurrent(h_DC, 0)) then
MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);
if (not wglDeleteContext(h_RC)) then
begin
MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
h_RC := 0;
end;
if ((h_DC > 0) and (ReleaseDC(h_Wnd, h_DC) = 0)) then
begin
MessageBox(0, 'Release of device context failed!', 'Error', MB_OK or MB_ICONERROR);
h_DC := 0;
end;
if ((h_Wnd <> 0) and (not DestroyWindow(h_Wnd))) then
begin
MessageBox(0, 'Unable to destroy window!', 'Error', MB_OK or MB_ICONERROR);
h_Wnd := 0;
end;
if (not UnRegisterClass('OpenGL', hInstance)) then
begin
MessageBox(0, 'Unable to unregister window class!', 'Error', MB_OK or MB_ICONERROR);
// hInstance := 0;
end;
end;
function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
var
wndClass : TWndClass;
dwStyle : DWORD;
dwExStyle : DWORD;
dmScreenSettings : DEVMODE;
PixelFormat : GLuint;
h_Instance : HINST;
pfd : TPIXELFORMATDESCRIPTOR;
begin
h_Instance := GetModuleHandle(nil);
ZeroMemory(@wndClass, SizeOf(wndClass));
with wndClass do
begin
style := CS_HREDRAW or
CS_VREDRAW or
CS_OWNDC;
lpfnWndProc := @WndProc;
hInstance := h_Instance;
hCursor := LoadCursor(0, IDC_ARROW);
lpszClassName := 'OpenGL';
end;
if (RegisterClass(wndClass) = 0) then
begin
MessageBox(0, 'Failed to register the window class!', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit
end;
if Fullscreen then
begin
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
with dmScreenSettings do begin
dmSize := SizeOf(dmScreenSettings);
dmPelsWidth := Width;
dmPelsHeight := Height;
dmBitsPerPel := PixelDepth;
dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
end;
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
begin
MessageBox(0, 'Unable to switch to fullscreen!', 'Error', MB_OK or MB_ICONERROR);
Fullscreen := False;
end;
end;
if (Fullscreen) then
begin
dwStyle := WS_POPUP or
WS_CLIPCHILDREN
or WS_CLIPSIBLINGS;
dwExStyle := WS_EX_APPWINDOW;
ShowCursor(False);
end
else
begin
dwStyle := WS_OVERLAPPEDWINDOW or
WS_CLIPCHILDREN or
WS_CLIPSIBLINGS;
dwExStyle := WS_EX_APPWINDOW or
WS_EX_WINDOWEDGE;
end;
h_Wnd := CreateWindowEx(dwExStyle,
'OpenGL',
WND_TITLE,
dwStyle,
0, 0,
Width, Height,
0,
0,
h_Instance,
nil);
if h_Wnd = 0 then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
h_DC := GetDC(h_Wnd);
if (h_DC = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
with pfd do
begin
nSize := SizeOf(TPIXELFORMATDESCRIPTOR);
nVersion := 1;
dwFlags := PFD_DRAW_TO_WINDOW
or PFD_SUPPORT_OPENGL
or PFD_DOUBLEBUFFER;
iPixelType := PFD_TYPE_RGBA;
cColorBits := PixelDepth;
cRedBits := 0;
cRedShift := 0;
cGreenBits := 0;
cGreenShift := 0;
cBlueBits := 0;
cBlueShift := 0;
cAlphaBits := 0;
cAlphaShift := 0;
cAccumBits := 0;
cAccumRedBits := 0;
cAccumGreenBits := 0;
cAccumBlueBits := 0;
cAccumAlphaBits := 0;
cDepthBits := 16;
cStencilBits := 0;
cAuxBuffers := 0;
iLayerType := PFD_MAIN_PLANE;
bReserved := 0;
dwLayerMask := 0;
dwVisibleMask := 0;
dwDamageMask := 0;
end;
PixelFormat := ChoosePixelFormat(h_DC, @pfd);
if (PixelFormat = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
h_RC := wglCreateContext(h_DC);
if (h_RC = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
if (not wglMakeCurrent(h_DC, h_RC)) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil);
ShowWindow(h_Wnd, SW_SHOW);
SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd);
glResizeWnd(Width, Height);
glInit();
Result := True;
end;
function WinMain(hInstance : HINST; hPrevInstance : HINST;
lpCmdLine : PChar; nCmdShow : Integer) : Integer; stdcall;
var
msg : TMsg;
finished : Boolean;
DemoStart, LastTime : DWord;
begin
finished := False;
if not glCreateWnd(1024, 768, True, 32) then
begin
Result := 0;
Exit;
end;
DemoStart := GetTickCount();
while not finished do
begin
if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then
begin
if (msg.message = WM_QUIT) then
finished := True
else
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end
else
begin
Inc(FPSCount);
LastTime :=ElapsedTime;
ElapsedTime :=GetTickCount() - DemoStart;
ElapsedTime :=(LastTime + ElapsedTime) DIV 2;
glDraw();
SwapBuffers(h_DC);
if (keys[VK_ESCAPE]) then
finished := True
else
end;
end;
glKillWnd(FALSE);
Result := msg.wParam;
end;
begin
WinMain( hInstance, hPrevInst, CmdLine, CmdShow );
end.
P.S а у тебя чё стоит FP или Delphi :rolleyes:
