Форум: "WinAPI";
Текущий архив: 2004.02.25;
Скачать: [xml.tar.bz2];

Вниз

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

← →
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.


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

---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.02.25;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.036 c