[WinAPI]Bug w progu nie do znalezienia?

0

mam program, który powinien działać i działą ale tylko w trybie FullScreen, w windowed się knoci, ale nie potafię powiedzieć gdzie. Program bezpośredno translatowany z NeHe OpenGL lesson 1. Prog w delphi do tego działa, a mój nie działa. Jedyna różnica jaką ja zauważam i zrobiłem spcepcjalnie to ustawienie koloru czyszczenia na biały zamiast czarnego. kod jest tu:

program Basic;

uses
	Windows, OpenGL, Types, Messages;

var
	h_RC: HGLRC=0;
	h_DC: HDC=0;
	h_Wnd: HWND=0;
	Keys: array [0..255] of Bool;
	Active: Bool=True;
	FullScreen: Bool=True;

procedure ResizeGLScene(Width: GLSizei; Height: GLSizei);
begin
	if (Height=0) then
		begin
			Height:=1;
		end;
	glViewport(0, 0, Width, Height);
	glMatrixMode(GL_PROJECTION);
	glLoadIdentity();
	gluPerspective(45.0, Width/Height, 0.1, 100.0);
	glMatrixMode(GL_MODELVIEW);
	glLoadIdentity();
end;

function InitGL(): Bool;
begin
	glShadeModel(GL_SMOOTH);
	glClearColor(1.0, 1.0, 1.0, 0.0);  //white
	glClearDepth(1.0);
	glEnable(GL_DEPTH_TEST);
	glDepthFunc(GL_LEQUAL);
	glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
	Result:=True;
end;

function DrawGLScene(): Bool;
begin
	glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
	glLoadIdentity();
	Result:=True;
end;

function WndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;stdcall;
begin
	case uMsg of
		WM_ACTIVATE:
			begin
				if (HIWORD(wParam)=0) then
					Active:=True
				else
					Active:=False;
				Result:=0;
			end;
		WM_SYSCOMMAND:
			begin
				case wParam of
					SC_SCREENSAVE, SC_MONITORPOWER:
						begin
							Result:=0;
							Exit;
						end;
				end;
			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
				ResizeGLScene(LOWORD(lParam), HIWORD(lParam));
				Result:=0;
			end;
	else
		begin
			Result:=DefWindowProc(hWnd, uMsg, wParam, lParam);
		end;
	end;
end;

procedure KillGLWindow();
begin
	if (FullScreen=True) then
		begin
			ChangeDisplaySettings(TDeviceMode(nil^), 0);
			ShowCursor(True);
		end;
	if (h_Rc<>0) then
		begin
			if (not wglMakeCurrent(h_Dc,0)) then
				begin
					MessageBox(0, 'Release of DC and RC Failed!', 'Shutdown Error',
						MB_ICONSTOP or MB_OK);
				end;
			if (not wglDeleteContext(h_Rc)) then
				begin
					MessageBox(0, 'Release Rendering Contex Failed!', 'Shutdown Error',
						MB_ICONSTOP or MB_OK);
					h_Rc:=0;
				end;
			if ((h_Dc=1) and (ReleaseDC(h_Wnd, h_Dc)<>0)) then
				begin
					MessageBox(0, 'Release Device Contex Failed!', 'Shutdown Error',
						MB_ICONSTOP or MB_OK);
					h_Dc:=0;
				end;
			if ((h_Wnd<>0) and (not DestroyWindow(h_Wnd))) then
				begin
					MessageBox(0, 'Could not release h_Wnd!', 'Shutdown Error',
						MB_ICONSTOP or MB_OK);
					h_Wnd:=0;
				end;
			if (not UnregisterClass('OpenGL', hInstance)) then
				begin
					MessageBox(0, 'Could not unregister class "OpenGL"', 'Shutdown Error',
						MB_ICONSTOP or MB_OK);
				end;
		end;
end;

function CreateGLWindow(Title: PChar; Width, Height, Bits: Integer; FullScreenFlag: Bool):Bool;
	var
		PixelFormat: GLuint;
		wc: WNDCLASS;
		dwExStyle,
		dwStyle: DWord;
		WindowRect: TRect;
		h_Instance: HINST;
		dmScreenSettings: DEVMODE;
		pfd: PixelFormatDescriptor;
begin
	WindowRect:=Rect(0, 0, Width, Height);
	h_Instance:=GetModuleHandle(nil);
	FullScreen:=FullScreenFlag;
	with wc do
		begin
			Style:=CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
			lpfnWndProc:=@WndProc;
			cbClsExtra:=0;
			cbWndExtra:=0;
			hInstance:=h_Instance;
			hIcon:=LoadIcon(0, IDI_WINLOGO);
			hCursor:=LoadCursor(0, IDC_ARROW);
			hbrBackground:=0;
			lpszMenuName:=nil;
			lpszClassName:='OpenGL';
		end;
	if (RegisterClass(wc)=0) then
		begin
			MessageBox(0, 'Failed to register WindowClass!', 'Error',
				MB_ICONSTOP or MB_OK);
			Result:=False;
			Exit;
		end;
	if (FullScreen=True) then
		begin
			ZeroMemory(@dmScreenSettings, SizeOf(DEVMODE));
			with dmScreenSettings do
				begin
					dmSize:=SizeOf(DEVMODE);
					dmPelsWidth:=Width;
					dmPelsHeight:=Height;
					dmBitsPerPel:=Bits;
					dmDisplayFrequency:=75;//added - 75 hz is better than 60, and it's safe!
					dmFields:=DM_DISPLAYFREQUENCY or DM_BITSPERPEL or DM_PELSWIDTH or
						DM_PELSHEIGHT;
				end;
			if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN)<>DISP_CHANGE_SUCCESSFUL) then
				begin
					if (MessageBox(0,
						'The Requested Fullscreen Mode Is Not Supported By Your Video Card. Use Windowed Mode Instead?',
						'NeHe OpenGL',
						MB_ICONEXCLAMATION or MB_YESNO)=IDYES) then
						begin
							FullScreen:=False;
						end
					else
						begin
							MessageBox(0, 'Program will now close.', 'Error',
								MB_ICONINFORMATION or MB_OK);
							Result:=False;
							Exit;
						end;
				end;
		end;
	if (FullScreen=True) then
		begin
			dwExStyle:=WS_EX_APPWINDOW;
			dwStyle:=WS_POPUP;
			ShowCursor(False);
		end
	else
		begin
			dwExStyle:=WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;
			dwStyle:=WS_OVERLAPPEDWINDOW;
		end;
	AdjustWindowRectEx(WindowRect, dwStyle, False, dwExStyle);
	h_Wnd:=CreateWindowEx(dwExStyle, 'OpenGL', Title,
		WS_CLIPSIBLINGS or WS_CLIPCHILDREN or dwStyle, 0, 0,
		WindowRect.Right-WindowRect.Left, WindowRect.Bottom-WindowRect.Top,
		0, 0, hInstance, nil);
	if (h_Wnd=0) then
		begin
			KillGLWindow();
			MessageBox(0, 'Window Creation Error.', 'Error',
				MB_ICONSTOP or MB_OK);
			Result:=False;
			Exit;
		end;
	ZeroMemory(@pfd, SizeOf(PixelFormatDescriptor));
	with pfd do
		begin
			nSize:=SizeOf(PixelFormatDescriptor);
			nVersion:=1;
			dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
			iPixelType:=PFD_TYPE_RGBA;
			cColorBits:=Bits;
			cRedBits:=0;
			cRedShift:=0;
			cGreenBits:=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;
	h_Dc:=GetDC(h_Wnd);
	if (h_Dc=0) then
		begin
			KillGLWindow();
			MessageBox(0, 'Can''t Create A GL Device Context.', 'Error',
				MB_ICONSTOP or MB_OK);
			Result:=True;
			Exit;
		end;
	PixelFormat:=ChoosePixelFormat(h_Dc, @pfd);
	if PixelFormat=0 then
		begin
			KillGLWindow();
			MessageBox(0, 'Can''t find suitable PixelFormat', 'Error',
				MB_ICONSTOP or MB_OK);
			Result:=True;
			Exit;
		end;
	if (not SetPixelFormat(h_Dc, PixelFormat, @pfd)) then
		begin
			KillGLWindow();
			MessageBox(0, 'Can''t set PixelFormat', 'Error',
				MB_ICONSTOP or MB_OK);
			Result:=False;
			Exit;
		end;
	h_RC:=wglCreateContext(h_Dc);
	if (h_Rc=0) then
		begin
			KillGLWindow();
			MessageBox(0, 'Can''t create a GL Rendering context', 'Error',
				MB_ICONSTOP or MB_OK);
			Result:=True;
			Exit;
		end;
	if (not wglMakeCurrent(h_DC, h_RC)) then
		begin
			KillGLWindow();
			MessageBox(0, 'Can''t activate the GL Rendering context', 'Error',
				MB_ICONSTOP or MB_OK);
			Result:=True;
			Exit;
		end;
	ShowWindow(h_Wnd, SW_SHOW);
	SetForegroundWindow(h_Wnd);
	SetFocus(h_Wnd);
	ResizeGLScene(Width, Height);
	if (not InitGL()) then
		begin
			KillGLWindow();
			MessageBox(0, 'Initialization Failed!', 'Error', MB_ICONSTOP or MB_OK);
			Result:=True;
			Exit;
		end;
	Result:=True;
end;

function WinMain(hInstance: HINST; hPrevInstance: HINST; lpCmdLine: PChar;
	nCmdShow: Integer): Integer;stdcall;
var
	msg: TMsg;
	Done: Bool;
begin
	Done:=False;
	if (MessageBox(0, 'Would You run in fullscreen mode?', 'OpenGL_Demo',
		MB_ICONQUESTION or MB_YESNO)=IDYES) then
		begin
			FullScreen:=True;
		end
	else
		begin
			FullScreen:=False;
		end;
	if (not CreateGLWindow('NeHe''s OpenGL Framework', 640, 480, 32, FullScreen)) then
		begin
			Result:=0;
			Exit;
		end;
	while (not Done) do
		begin
			if (PeekMessage(msg, 0,0,0, PM_REMOVE)) then
				begin
					if (msg.message=WM_QUIT) then
						begin
							Done:=True;
						end
					else
						begin
							TranslateMessage(msg);
							DispatchMessage(msg);
						end;
				end
			else
				begin
					if (Active=True) then
						begin
							if (Keys[VK_ESCAPE]=True) then
								begin
									Done:=True;
								end
							else
								begin
									DrawGLScene();
									SwapBuffers(h_Dc)
								end;
						end;
					if (Keys[VK_F1]=True) then
						begin
							Keys[VK_F1]:=False;
							KillGLWindow();
							FullScreen:=not FullScreen;
							if (not CreateGLWindow('OpenGL_Demo', 640, 480, 32, FullScreen)) then
								begin
									Result:=0;
									Exit;
								end;
						end;
				end;
		end;
	KillGLWindow();
	Result:=msg.wParam;
end;

begin
	WinMain(hInstance, hPrevInst, CmdLine, CmdShow);
end.

kod delphi działający jest tu: http://nehe.gamedev.net/tutorials/delphi/lesson01.zip

0

Ja mam na dysku starszą chyba wersje tej lekcji, zachowująca sie troche inaczej niż ta (np. reagującą na zwykłe zamykanie okna), ale modyfikowanie glClearColor na biały działa u mnie w obu wersjach [???] .

0

Ciekawe gdzie leży błąd? powinno się normalnie zamykać, wszystko powinno być OK, ale tak nie jest. W trybie full screen jest OK... Jakby ktoś mógł sprawdzić mój kod byłbym wdzięczny. <ort>Równierz </ort>za wskazanie błędów, bo ostatni raz w programowanie bawiłem się dawno temu...

1 użytkowników online, w tym zalogowanych: 0, gości: 1