Проблема с ХР

← →
SkyRanger (2003-12-16 04:05) [0]

Есть код, он ниже, под 98 все ок, под ХР он не создает окно, после прохода функции создания окна он выходит из программы, но тока под ХР!

program OGL3Demo; {%ToDo "OGL3Demo.todo"} uses Windows, Messages, OpenGl, Math, OGL in "OGL.pas", Normals in "Normals.pas", GLWin in "GLWin.pas", IniFile in "IniFile.pas", LogFile in "LogFile.pas", Error in "Error.pas", Textures in "Textures.pas", Dialog in "dialog.pas", Surface in "surface.pas", Fonts in "fonts.pas", Camera in "camera.pas", Vector in "vector.pas", Lights in "Lights.pas", Mouse in "Mouse.pas", Graph2D in "Graph2D.pas", Plane in "Plane.pas", Dynarrays in "dynarrays.pas", Console in "Console.pas", Engine in "Engine.pas", Color in "Color.pas", Triangle in "Triangle.pas", Constants in "Constants.pas"; {$R *.RES} const timer_id = 1; // ID таймера ClassName = "OGL3DEDEMO"; // Уникальное название класса Var MyWnd : hWnd; // Дескриптор окна Msg : TMsg; // Соообщения win32 FPSCnt : Integer; // Количество FPS IsFinish : Boolean; // Признак окончания работы WinHeight, WinWidth : Integer; // Размеры окна WinTop, WinLeft : Integer; // Положение окна StartTickCount : Cardinal; OldTickCount : Cardinal; //========================================================================== procedure MyTimerProc(H:HWND;MSG:UINT;idTimer:UINT;dwTime:DWORD); stdcall; begin end; //========================================================================== { MyWndProc Функция обработки главного окна программы. } function MyWndProc(wnd: hWnd; msg, wParam, lParam: longint): longint; stdcall; var s : string; begin case msg of WM_CREATE : // Инициализация при создании окна begin OnWindowCreate(wnd,WinHeight,WinWidth,WinTop,WinLeft); end; WM_MOVE : begin // Изменение положения при перемещении окна WinTop := LOWORD(lParam); WinLeft:= HIWORD(lParam); end; WM_SIZE:begin // На случай изменения размеров окна OnWinResize(LOWORD(lParam),HIWORD(lParam)); end; WM_DESTROY: // Выход из программы begin PostQuitMessage(0); result := 0; end; WM_TIMER: // Периодическое обновление окна begin if wparam = 1 then // Обновление счетчика FPS begin str(FPSCnt,s); SetWindowText(mywnd, PChar(WindowTitle+"v "+EngineVersion+" Demo FPS : " + s)); FPSCnt := 0; Result := 0; end; end; WM_KEYDOWN : // При нажатии клавиши отмечаем ее begin keyBuf[wParam] := True; Result := 0; end; WM_KEYUP: // Когда клавиша отжата отмечаем это begin keyBuf[wParam] := False; Result := 0; end; else result := DefWindowProc(wnd, msg, WParam, LParam); end; end; //------------------------------------------------------------- { CreateMyWnd Вызывается для создания окна. } function CreateMyWnd: hWnd; var WC : TWndClass; // Класс окна hInstance : HINST; // Хэндл модуля begin hInstance := GetModuleHandle(nil); // Получаем заголовок ZeroMemory(@wc, SizeOf(wc)); // На всякий случай очищаем память // Заполняем поля данных класса дннными wc.style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC; wc.lpfnWndProc := @MyWndProc; wc.cbClsExtra := 0; wc.cbWndExtra := 0; wc.hInstance := hInstance; wc.hIcon := LoadIcon(hinstance, IDI_ASTERISK); wc.hCursor := LoadCursor(hinstance, IDC_HAND); wc.hbrBackground := COLOR_WINDOW; wc.lpszMenuName := ""; wc.lpszClassName := ClassName; // Регистрируем класс if RegisterClass(wc) = 0 then halt(0); // Создаем окно mywnd := CreateWindowEx( WS_EX_APPWINDOW or WS_EX_WINDOWEDGE, ClassName, WindowTitle+" v "+EngineVersion, WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN, WinTop, WinLeft, WinHeight, WinWidth, 0, 0, hInstance, nil); // Проверяем результат if result = 0 then halt(0); //Создаем таймер для обновления содержимого окна SetTimer(mywnd, timer_id, 1000, nil); end; //========================================================================== { Тело программы } begin //Задаем размеры окна WinHeight:=400; WinWidth:=400; WinTop:=100; WinLeft:=100; CreateMyWnd; //Создаем окно и получаем дискриптор // Для уверенности что окно будет после запуска поверх остальных ShowWindow(mywnd, SW_SHOW); UpdateWindow(mywnd); SetFocus(mywnd); //Пока не будет посланно сообщение 0 программа будет работать IsFinish := False; StartTickCount:=GetTickCount(); while not IsFinish do begin if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin if Msg.Message = WM_QUIT then IsFinish := True else begin TranslateMessage(msg); DispatchMessage(msg); end; end else begin // FPSCnt:=FPSCnt+1; // Увеличиваем счетчик FPS StartTickCount:=GetTickCount(); if (StartTickCount-OldTickCount>10) then begin WinPaint(); // Прорисовываем окно FPSCnt:=FPSCnt+1; // Увеличиваем счетчик FPS OldTickCount:=GetTickCount(); end; // Если нажата ESC на выход if (keyBuf[VK_ESCAPE]) then IsFinish := True; HandleKeys(); // обрабатываем нажатия клавишь end; end; //Освобождение памяти FreeMem; KillTimer(mywnd, timer_id); UnRegisterClass(ClassName,hInstance); end.

← →
BiN (2003-12-16 11:25) [1]

во-первых, не wc.lpszMenuName := "";, а :=nil
а во-вторых, у тебя резулт, скорее всего всегда будет равняться нулю

← →
abc (2003-12-16 13:20) [2]

если я не ошибаюсь то использовать PeekMessage в цикле обработки сообщений не совсем корректно, да и вообще очень бы не советовал нагараживать различные счёттчики в этот самый цикл, используй GetMessage.

← →
SkyRanger (2003-12-17 04:30) [3]

>abc (16.12.03 13:20) [2]
используется в туториалах NeHE и все работает

А вообще новый прикол, под ХР еще не пробывал, но теперь такая же веселуха под 98 началась я внес изменения

// FPSCnt:=FPSCnt+1; // Увеличиваем счетчик FPS StartTickCount:=GetTickCount(); if (StartTickCount-OldTickCount>10) then begin WinPaint(); // Прорисовываем окно FPSCnt:=FPSCnt+1; // Увеличиваем счетчик FPS OldTickCount:=GetTickCount(); end;

заменил на

FPSCnt:=FPSCnt+1; // Увеличиваем счетчик FPS OldTickCount:=(OldTickCount + (GetTickCount - StartTickCount) ) div 2; WinPaint(OldTickCount); // Прорисовываем окно

И теперь если строка OldTickCount:=(OldTickCount + (GetTickCount - StartTickCount) ) div 2;
есть в исходнике, то происходит при выполнении выход с 0 кодом из программы при создании окна, а если нет то все работает ок. Методом научного втыка, я ывяснил что все это из за вызова GetTickCount и вообще в целом из за этой строки... Че за глюк??? Отладчик до нее даже не доходит!

Если ее убрать все работает, при том что в туториалеЮ который использует этуже схему, только в 3 строки все работает на ура...

Вот часть сэмпла из NeHe туторов.

function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; begin case (Msg) of WM_CREATE: begin // Insert stuff you want executed when the program starts end; WM_CLOSE: begin PostQuitMessage(0); Result := 0 end; WM_KEYDOWN: // Set the pressed key (wparam) to equal true so we can check if its pressed begin keys[wParam] := True; Result := 0; end; WM_KEYUP: // Set the released key (wparam) to equal false so we can check if its pressed begin keys[wParam] := False; Result := 0; end; WM_SIZE: // Resize the window with the new width and height begin glResizeWnd(LOWORD(lParam),HIWORD(lParam)); Result := 0; end; WM_TIMER : // Add code here for all timers to be used. begin if wParam = FPS_TIMER then begin FPSCount :=Round(FPSCount * 1000/FPS_INTERVAL); // calculate to get per Second incase intercal is less or greater than 1 second SetWindowText(h_Wnd, PChar(WND_TITLE + " [" + intToStr(FPSCount) + " FPS]")); FPSCount := 0; Result := 0; end; end; else Result := DefWindowProc(hWnd, Msg, wParam, lParam); // Default result if nothing happens end; end; function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean; var wndClass : TWndClass; // Window class dwStyle : DWORD; // Window styles dwExStyle : DWORD; // Extended window styles dmScreenSettings : DEVMODE; // Screen settings (fullscreen, etc...) PixelFormat : GLuint; // Settings for the OpenGL rendering h_Instance : HINST; // Current instance pfd : TPIXELFORMATDESCRIPTOR; // Settings for the OpenGL window begin h_Instance := GetModuleHandle(nil); //Grab An Instance For Our Window ZeroMemory(@wndClass, SizeOf(wndClass)); // Clear the window class structure with wndClass do // Set up the window class begin style := CS_HREDRAW or // Redraws entire window if length changes CS_VREDRAW or // Redraws entire window if height changes CS_OWNDC; // Unique device context for the window lpfnWndProc := @WndProc; // Set the window procedure to our func WndProc hInstance := h_Instance; hCursor := LoadCursor(0, IDC_ARROW); lpszClassName := "OpenGL"; end; ... h_Wnd := CreateWindowEx(dwExStyle, "OpenGL", WND_TITLE, dwStyle, 0, 0, Width, Height, 0, 0, h_Instance, nil); ... SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil); ... 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(800, 600, FALSE, 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 ProcessKeys; end; end; glKillWnd(FALSE); Result := msg.wParam; end; begin WinMain( hInstance, hPrevInst, CmdLine, CmdShow ); end.

Пришлось сильно порезать не влезала

Проблема с ХР Найти похожие ветки