-
Почему дёргается экран. Когда передвигаю мышку или нажимаю любую клавишу. Такое творится только при разрешении 1024 х 768. Почему? Внизу код.
===================== Unit =================================
interface
uses Windows, Messages, OpenGL, ANSORO_UTILITS;
const ENGINE_NAME = 'HARIER'; ENGINE_VERSION = '0.1';
type TOnRender = procedure; TOnUpdate = procedure; TOnInit = procedure;
type TEngine = class h_Msg : TMSG; h_Wnd : hWnd; h_wc: TWndClassEX; h_DC : HDC; h_RC: HGLRC; PFD: TPixelFormatDescriptor; nPFD: integer; private FOnRender: TOnRender; FOnUpdate: TOnUpdate; FOnInit : TOnInit; public constructor Create; destructor Destroy; public // SYSTEM procedure Init(name: PChar; width, height: integer; bpp: byte; FullScreen: Boolean = false); procedure SetFullScreen(width, height: integer; bpp: byte); procedure Quit; procedure Loop; // OPENGL procedure InitGL; procedure SetPFD;
property OnRender: TOnRender read FOnRender write FOnRender; property OnUpdate: TOnUpdate read FOnUpdate write FOnupdate; property OnInit: TOnInit read FOnInit write FOnInit; private eFullScreen: boolean; eWidth,eHeight: integer; eBpp: Byte; eFinished: Boolean; end;
procedure InitEngine;
var engine: TEngine;
implementation
procedure InitEngine; begin engine := TEngine.Create; end;
constructor TEngine.Create; begin eFinished := false; end;
function WndProc(h_wnd:hWND; events: Integer; wparam: wparam; lparam: lparam):lresult;stdcall; begin case events of WM_CREATE: begin end; WM_DESTROY: begin PostQuitMessage(0); Result:= 0; exit; end; WM_PAINT: begin glClear(GL_DEPTH_BUFFER_BIT OR GL_COLOR_BUFFER_BIT); glClearColor(0,1,0,0); // ValidateRect(h_wnd,nil); result := 0; exit; end;
end; Result := DefWindowProc(h_wnd, events, wparam, lparam); end;
procedure TEngine.SetPFD; begin FillChar(pfd, sizeof(pfd), 0); pfd.nVersion := 1; pfd.nSize := sizeof(pfd); pfd.dwFlags := PFD_DOUBLEBUFFER or PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL; pfd.iPixelType := PFD_TYPE_RGBA; pfd.cColorBits := eBpp; pfd.cStencilBits := 0; pfd.cDepthBits := 32; nPFD := ChoosePixelFormat(h_dc, @pfd); SetPixelFormat( H_DC, nPFD, @pfd ); end;
procedure TEngine.InitGL; begin SetPFD; h_rc := wglCreateContext(h_dc); wglMakeCurrent(h_dc, h_rc); glClear(GL_DEPTH_BUFFER_BIT OR GL_COLOR_BUFFER_BIT); glClearColor(0,1,0,0); end;
procedure TEngine.SetFullScreen(width: Integer; height: Integer; bpp: Byte); var dm: DevMode; hr: HRESULT; DC: hdc; begin FillChar(dm, SizeOf(dm),0); dm.dmSize := SizeOf(DevMode); dm.dmFields := DM_PELSWIDTH OR DM_PELSHEIGHT OR DM_BITSPERPEL OR DM_DISPLAYFREQUENCY; dm.dmPelsWidth := width; dm.dmPelsHeight:= height; dm.dmBitsPerPel := bpp; dm.dmDisplayFrequency := 75; HR := ChangeDisplaySettings(dm, CDS_FULLSCREEN); end;
procedure TEngine.Init(name: PChar; width: Integer; height: Integer; bpp: Byte; FullScreen: Boolean = False); var dwExStyle : DWord; dwStyle : DWord; begin eWidth := width; eHeight:= height; eBpp := bpp;
ZeroMemory(@h_wc,SizeOf(h_wc)); h_wc.style := CS_HREDRAW OR CS_VREDRAW OR CS_OWNDC; h_wc.cbSize := sizeof(h_wc); h_wc.lpfnWndProc := @WndProc; h_wc.hInstance := hInstance; h_wc.hbrBackground:= COLOR_BTNFACE+1; h_wc.hCursor := LoadCursor(0,IDC_ARROW); h_wc.lpszClassName:= ENGINE_NAME;
WINDOWS.RegisterClassEx(h_wc);
if FullScreen then begin eFullScreen := true; dwExStyle := WS_OVERLAPPED or WS_EX_TOPMOST; // поверх всех окон dwStyle := WS_POPUP OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS; SetFullScreen(width,height,bpp); end else begin eFullScreen := false; dwExStyle := WS_OVERLAPPED or WS_EX_TOPMOST; // поверх всех окон dwStyle := WS_SYSMENU OR WS_MINIMIZEBOX OR WS_CLIPCHILDREN OR WS_CLIPSIBLINGS; end;
h_wnd := CreateWindowEX(dwExStyle,ENGINE_NAME,name,dwStyle,0,0,Width,Height,0,0,hInstance ,nil); h_dc := GetDC(h_wnd);
InitGL;
ShowWindow(h_wnd,SW_SHOW); SetForegroundWindow(h_Wnd);
end;
procedure TEngine.Loop; begin while GetMessage(h_msg,0,0,0) do begin DispatchMessage(h_msg); TranslateMessage(h_msg); SwapBuffers(h_dc); end; end;
procedure TEngine.Quit; begin eFinished := true; end;
destructor TEngine.Destroy; begin
Quit;
DestroyWindow(h_wnd); UnRegisterClass(ENGINE_NAME,hInstance);
wglDeleteContext(h_rc); ReleaseDC(h_wnd,h_dc);
wglMakeCurrent(0, 0); wglDeleteContext(h_RC); ReleaseDC(h_Wnd, h_DC);
if eFullscreen then ChangeDisplaySettings(TDevMode(nil^), CDS_FULLSCREEN);
end;
===================== Application ================================= program APP;
uses Windows, OpenGL, ENGINE in 'ANSORO_ENGINE.pas', UTILITS in 'ANSORO_UTILITS.pas';
begin InitEngine; engine.Init('APP',1024,768,32,true); engine.Loop; end.
-
Частота не поддерживаемая этим разрешением. Отсюда и косяк. Попробуй не трогать частоту. ;)
-
Зачем вообще принудительно менять разрешение ?.. Если что то уже настроено, значит пользователю так удобно :)
-
> [2] Rial ©
+1 Конечно, если не даеться выбор разрешений по вкусу :)
-
убрал частоту не помогло. Я двигаю мышку и тогда начинает перерисоваться экран . Странно. Серый потом зелёный. если не двигаю мышку то нормально. Такое только в полноекранном режиме.
-
Rial © (25.05.07 22:53) [2]
Объясни что ты имел ввиду. Я чегото непонял :-)
-
> Rial © (25.05.07 22:53) [2]
У меня, к примеру, разрешение рабочего стола 1600x1200. Не каждая 3D игра будет производительна в таком разрешение, а 2D игрушки даже таких разрешений, как правило, не знают...
-
Может быть косяки видеокарты. ПРишли ехешник, мы потестим на своих машинах.
-
А где я могу его выложить?
-
Вообще я думаю что то я всётаки на портачил так пробовал исходники с сайта Sulaco . Его исходники идут нормально.
Еще вопрос. Что лучше использовать.
PGL_WindowInit = ^TGL_WindowInit; TGL_WindowInit = record // Window Creation Info application: PApplication; // Application Structure title: PAnsiChar; // Window Title width: Integer; // Width height: Integer; // Height bitsPerPixel: Integer; // Bits Per Pixel isFullScreen: Boolean; // FullScreen? end;
или
TGL_WindowInit = class // Window Creation Info application: PApplication; // Application Structure title: PAnsiChar; // Window Title width: Integer; // Width height: Integer; // Height bitsPerPixel: Integer; // Bits Per Pixel isFullScreen: Boolean; // FullScreen? end;
-
нафиг класс?
-
ИМХО, лучше так:
>var > GL_WindowInit : packed record // Window Creation Info > application: PApplication; // Application Structure > title: PAnsiChar; // Window Title > width: Integer; // Width > height: Integer; // Height > bitsPerPixel: Integer; // Bits Per Pixel > isFullScreen: Boolean; // FullScreen? > end;
-
Почему запаковынный рекорд луычше? Медленней же работает.
-
> Почему запаковынный рекорд луычше? Медленней же работает.
Ну поставь обычный)))
-
А вообще Записи не нужно ни конструктора ни деструтора. Может біть она всётаки лучше. Что лучше делать класс движка или запись?
-
> А вообще Записи не нужно ни конструктора ни деструтора.
Нет.
> Что лучше делать класс движка или запись?
Ну я б лучше делал запись => быстрее и экономнее ;)))
-
> [14] HARIER (26.05.07 20:04) > Что лучше делать класс движка или запись?
В начале нужно сделать что угодно, работающее без сбоев и глюков. А вообще, запись - это метод представления данных, а класс - это нечто большее. С одной стороны, для отладки проще обойтись записями, потом все это завернуть в красивую обертку, обеспечивающую целостность данных. Возможно, наступит такой момент, когда классы в итоге будут ощутимо замедлять работу... но это маловероятно.
> [5] HARIER (26.05.07 00:31) > Rial © (25.05.07 22:53) [2] > Объясни что ты имел ввиду. Я чегото непонял :-)
У меня стоит разрешение 1024*768, частота обновление 75Гц... если какая то программа принудительно меняет его- это 80% шанс отправиться в корзину ежеминутно.
-
> У меня стоит разрешение 1024*768, частота обновление 75Гц... > если какая то программа принудительно меняет его- это > 80% шанс отправиться в корзину ежеминутно.
Практически любая игра меняет разрешение... НЕ играешь чтоли совсем? :))
-
> [11] ElectriC © (26.05.07 17:18) > ИМХО, лучше так: > >var > > GL_WindowInit : packed record // Window Creation > Info > > application: PApplication; // Application Structure > > title: PAnsiChar; // Window Title > > width: Integer; // Width > > height: Integer; // Height > > bitsPerPixel: Integer; // Bits Per Pixel > > isFullScreen: Boolean; // FullScreen? > > end;
Конкретно в данном случае вставка слова "packed" не играет никакой роли. Почему? - можно почитать о правилах выравнивания полей. Конечно, когда составляешь свою структуру записи, лучше сразу выбирать такой порядок полей, чтобы размер записи был минимальным. А необходимоть в "packed" в основном возникает при переносе кода с других языков.
> [17] @!!ex © (26.05.07 20:26) > НЕ играешь чтоли совсем? :))
Нет...
-
Мучался весь день. И ни чего не получилось. Мне нужно написать модуль который создаёт окно и контекст.Первый пример я делал по книге. Своими мозгами. А второй по исходникам с Sulaco. И что получилось выдаются ошибки: Невозможно создать класс, создать окно .... У меня уже голова не варит. Как нужно правильно сделать. Получается что своими мозгами заработало но с глюками, а метом Копировать Вставить вообще не работает. Я думаю вы уже много раз писали подобное :-) Помогите пожалуйста...
unit ENGINE;
interface
uses
Windows,
Messages,
OpenGL,
UTILITS;
const
ENGINE_NAME = 'ANSORO';
ENGINE_VERSION = '1.0';
type
TOnRender = procedure;
TOnUpdate = procedure;
TOnInit = procedure;
ENG = ^Tengine;
TEngine = class
h_wnd: HWND;
h_msg: TMsg;
h_wc: TWndClassEX;
h_dc: HDC;
h_rc: HGLRC;
eFullScreen: Boolean;
eWidth,
eHeight: Integer;
public
procedure InitEngine(name: PChar; width, height: integer; bpp: integer; FullScreen: Boolean = false);
procedure Loop;
procedure Quit;
procedure glInit;
procedure glKillWnd(Fullscreen : Boolean);
private
constructor Create;
destructor Destroy;
end;
procedure EngineInit;
var
engine: TEngine;
eFinished: Boolean;
implementation
procedure EngineInit;
begin
engine := TEngine.Create;
end;
constructor TEngine.Create;
begin
eFinished := false;
end;
procedure TEngine.glInit;
begin
glClearColor(0.0, 0.0, 0.0, 0.0); 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
Result := 0;
end;
WM_KEYUP: begin
Result := 0;
end;
WM_SIZE: begin
glResizeWnd(LOWORD(lParam),HIWORD(lParam));
Result := 0;
end;
else
Result := DefWindowProc(hWnd, Msg, wParam, lParam); end;
end;
-
procedure TEngine.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(ENGINE_NAME, hInstance)) then
begin
MessageBox(0, 'Unable to unregister window class!', 'Error', MB_OK or MB_ICONERROR);
hInstance := 0;
end;
end;
procedure TEngine.InitEngine(name: PAnsiChar; width: Integer; height: Integer; bpp: Integer; FullScreen: Boolean = False);
var
dwStyle : DWORD; dwExStyle : DWORD; dmScreenSettings : DEVMODE; PixelFormat : GLuint;
pfd : TPIXELFORMATDESCRIPTOR; begin
ZeroMemory(@h_wc, SizeOf(h_wC));
with h_wc do begin
style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC; lpfnWndProc := @WndProc;
hCursor := LoadCursor(0, IDC_ARROW);
lpszClassName := ENGINE_NAME;
end;
RegisterClassEX(h_wc);
eFullScreen := FullScreen;
if Fullscreen then
begin
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
with dmScreenSettings do begin dmSize := SizeOf(dmScreenSettings);
dmPelsWidth := Width; dmPelsHeight := Height; dmBitsPerPel := bpp; 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; // Doesn't draw within sibling windows
dwExStyle := WS_EX_APPWINDOW; ShowCursor(False); end
else
begin
dwStyle := WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS; // Doesn't draw within sibling windows
dwExStyle := WS_EX_APPWINDOW or WS_EX_WINDOWEDGE; end;
h_Wnd := CreateWindowEx(dwExStyle, ENGINE_NAME, NAME, dwStyle, 0, 0, Width, Height, 0, 0 , hInstance, nil); if h_Wnd = 0 then
begin
glKillWnd(Fullscreen); MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
Exit;
end;
// Try to get a device context
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);
Exit;
end;
-
Приведи листинг основного файла (.dpr).
-
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 := BPP; 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);
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);
Exit;
end;
// Create a OpenGL rendering context
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);
Exit;
end;
// Makes the specified OpenGL rendering context the calling thread's current rendering context
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);
Exit;
end;
ShowWindow(h_Wnd, SW_SHOW);
SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd);
glResizeWnd(Width, Height);
glInit(); end;
procedure TEngine.Loop;
begin
while GetMessage(h_msg, 0,0,0) do
begin TranslateMessage(h_msg);
DispatchMessage(h_msg);
end;
end;
procedure TEngine.Quit;
begin
eFinished := true;
end;
destructor TEngine.Destroy;
begin
glKillWnd(eFullscreen);
end;
end.
-
Приведи исходник .dpr файла.
-
код файла dpr
program game;
uses
Windows,
OpenGL,
ENGINE in 'ENGINE.pas',
GAME_ENGINE in 'GAME_ENGINE.pas',
UTILITS in 'UTILITS.pas';
begin
EngineInit;
engine.InitEngine('name',1024,768,32,false);
engine.Loop;
end.
-
вообще-то в loop нужно писать, ИМХО:
... Msg : MSG; ... ZeroMemory(@Msg, SizeOf(MSG));
while True do If (PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)) then begin If not GetMessage(Msg, 0, 0, 0) then Exit; TranslateMessage (Msg); DispatchMessage (Msg); end else If Active then //Активность приложения begin //тут рисуем OpenGL сцену end else WaitMessage;
-
ElectriC © (27.05.07 03:14) [25]
Учту. :-)
Посмотри на код может я чтото еще не праввильно делаю. Напиши что имено. Я исправлю.
Завтра с утра начну заново писать.
Как думаешь лучше смотреть на исходники или в книгу.
-
> HARIER
Совет - не спеши!!! Обдумай всё заранее!!! Когда я писал движок > http://slil.ru/24404040/874845188/School_54.rar < (хотя и сейчас продолжаю писать) смотрел больше на исходники, а в меньше степени - на книги (Хотя старался совмещать и то и другое). Я погляжу, что можно сделать!
-
1. Могу предположить что [25] поможет! Так-как в твоём случае перерисовка экрана присходит тока тогда, когда курсор мыши ползает по экрану! 2. ValidateRect(h_wnd,nil); - не нужен! 3. WM_CREATE: begin// eFinished := false; end; - не нужен!
-
Так ни чего и не получилось. Посмотрел свои старые проекты делал 3D сцены в любых видеорежимах. Всё идёт очень быстро и без глюков. Я На грани дипресии :-( Мне нужно сдать игру до 1 октября. Может можно написать игру в одном DPR файле как вы думаете. ДУмаю может оставить все функии по инициализации окна и графики. в главном файле DPR. Как вы считаете? Тогда у меня вдальнейшем может возникнуть другая проблема, Когда мне например надо будет писать Спрайтовый модуль и тп. То как мне вних использовать такие важные переменные как h_wnd, h_dc ... Пожалуйста посоветуйте мне как поступить. Внизу привёл пример одного из своих проектов:
program Example14;
uses
Windows,
Messages,
OpenGL;
const
APP_NAME = 'Example14';
mat_specular : array [0..3] of GLfloat = ( 1.0, 1.0, 1.0, 1.0 ); mat_shininess : GLfloat = 100.0; light_position : array [0..3] of GLfloat = ( 0.0, 0.0, 1.0, 0.0 ); white_light : array [0..3] of GLfloat = ( 1.0, 0.9, 0.8, 0.0 ); light_ambient: array [0..3] of GLfloat = ( 0.5, 0.0, 0.8, 0.0 );
fog_color: array [0..3] of GLfloat = ( 0.9, 0.9, 0.8, 0.0 );
var
h_wnd: HWND;
h_wc: TWndClassEx;
h_dc: HDC;
h_rc: HGLRC;
msg : TMsg;
keys: array[0..255] of Boolean;
finished : Boolean;
i: integer;
fogMode : GLint;
rot: real;
sph: gluQuadricObj;
roll, pitch, heading, planex, planey, planez: GLFloat;
distance, twist, elevation, azimuth: GLfloat;
ups_time_old: integer;
ups_time: integer;
fps_time: Integer;
fps_cur: Integer;
_FPS: integer;
Time, Time_delta: integer;
function IntToStr(n: integer):String;
begin
STR(n, Result);
end;
procedure PilotView(roll, pitch, heading, planex, planey, planez: GLFloat);
begin
glRotatef(roll,0,0,1);
glRotatef(roll,0,0,1);
glRotatef(roll,0,0,1);
glTranslatef(-planex, -planey, -planez);
end;
procedure PolarView(distance, twist, elevation, azimuth: GLfloat);
begin
glTranslatef(0,0,-distance);
glRotatef(-twist, 0,0,1);
glRotatef(-elevation, 1,0,0);
glRotatef(azimuth, 0,0,1);
end;
procedure LST(x,y: integer);
begin
fogMode := GL_EXP2;
glFogi(GL_FOG_MODE, fogMode);
glFogfv(GL_FOG_COLOR, @fog_color);
glFogf(GL_FOG_DENSITY, 0.05);
glHint(GL_FOG_HINT, GL_NICEST);
glFogf(GL_FOG_START, -10.0);
glFogf(GL_FOG_END, 10.0);
gluSphere(sph, 1.0, 100, 100);
end;
procedure Draw();
begin
glLoadIdentity(); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glTranslatef(1.0,1.0,-15.0);
glOrtho(0.0, 1.0, 0.0, 1.0, -1.0, 1.0); glColor3f(1.0,0.0,0.0);
gluLookAt(0,0,5,0,0,0,0,1,0);
PilotView(roll, pitch, heading, planex, planey, planez);
PolarView(distance, twist, elevation, azimuth);
glEnable(GL_FOG);
glRotatef(rot,1,1,1);
glTranslatef(1,0,0);
glPushMatrix;
glCallList(1);
glPopMatrix;
glRotatef(rot,1,0,0);
glTranslatef(1,0,0);
glPushMatrix;
glCallList(1);
glPopMatrix;
glRotatef(rot,1,1,0);
glTranslatef(0,1,0);
glPushMatrix;
glCallList(1);
glPopMatrix;
glRotatef(rot,1,1,0);
glTranslatef(-1,0,0);
glPushMatrix;
glCallList(1);
glPopMatrix;
glFlush;
end;
procedure Update;
begin
rot := rot+0.1;
if keys[vk_left] then
begin
roll := roll + 0.001;
pitch := pitch + 0.001;
heading := heading + 0.001;
planex := planex + 0.001;
planey := planey + 0.001;
planez := planez + 0.001;
end;
if keys[vk_right] then
begin
roll := roll - 0.001;
pitch := pitch - 0.001;
heading := heading - 0.001;
planex := planex - 0.001;
planey := planey - 0.001;
planez := planez - 0.001;
end;
if keys[49] then
begin
distance := distance + 0.01;
twist := twist + 0.01;
elevation := elevation + 0.01;
azimuth := azimuth + 0.01;
end;
if keys[50] then
begin
distance := distance - 0.01;
twist := twist - 0.01;
elevation := elevation - 0.01;
azimuth := azimuth - 0.01;
end;
if keys[51] then fogMode := GL_EXP;
if keys[52] then fogMode := GL_EXP2;
if keys[53] then fogMode := GL_LINEAR;
if keys[27] then finished := true; end;
-
procedure Init;
begin
glClearColor(1.0,1.0,1.0,1.0); glShadeModel(GL_smooth);
sph := gluNewQuadric();
gluQuadricNormals(sph, GLU_SMOOTH);
gluQuadricTexture(sph, GL_TRUE);
glMaterialfv(GL_FRONT, GL_SPECULAR, @mat_specular);
glMaterialfv(GL_FRONT, GL_SHININESS, @mat_shininess);
glLightfv(GL_LIGHT0, GL_DIFFUSE, @white_light);
glLightfv(GL_LIGHT0, GL_AMBIENT, @light_ambient);
glLightf(GL_LIGHT0, GL_SPOT_CUTOFF , 100);
glLightfv(GL_LIGHT0, GL_SPOT_DIRECTION, @light_position);
glEnable(GL_LIGHTING);
glEnable(GL_LIGHT0);
glEnable(GL_DEPTH_TEST);
glNewList(1,GL_COMPILE);
LST(1,1);
glEndList();
end;
procedure DestroyWnd(Fullscreen : Boolean);
begin
if Fullscreen then
begin
ChangeDisplaySettings(devmode(nil^), 0);
ShowCursor(True);
end;
wglMakeCurrent(h_DC, 0);
wglDeleteContext(h_RC);
ReleaseDC(h_Wnd, h_DC);
DestroyWindow(h_Wnd);
UnRegisterClass('OpenGL', hInstance);
end;
procedure Resize(Width, Height : Integer);
begin
glViewport(0, 0, Width, Height); glMatrixMode(GL_PROJECTION); glLoadIdentity(); gluPerspective(45.0, Width/Height, 1.0, 100.0); glMatrixMode(GL_MODELVIEW); glLoadIdentity(); end;
procedure DoFullScreen(width,height,bits: integer);
var
dm: DevMode;
hr: HRESULT;
DC: HDC;
begin
FillChar(dm, SizeOF(dm), 0); dm.dmSize := SizeOf(DevMode); dm.dmFields:= DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or DM_DISPLAYFREQUENCY;
dm.dmPelsWidth := width; dm.dmPelsHeight := height; dm.dmBitsPerPel := bits; dm.dmDisplayFrequency := 75; hr := ChangeDisplaySettings(dm,CDS_FULLSCREEN); end;
function WndProc(hwnd: HWND; msg: integer; wparam: WPARAM; lparam: LPARAM):LResult; stdcall;
begin
case msg of
WM_CREATE: begin end;
WM_DESTROY: begin PostQuitMessage(0); Result := 0; end;
WM_SIZE: begin Resize(LOWORD(lparam), HIWORD(lparam)); Result := 0; end;
WM_KEYDOWN: begin keys[wparam] := true; result := 0; end;
WM_KEYUP: begin keys[wparam] := false; result := 0; end;
else
Result := DefWindowProc(hwnd, msg, wparam, lparam);
end;
end;
-
procedure CreateAPP(width, height: integer; FullScreen: Boolean = false);
var
pfd: TPixelFormatDescriptor;
nPixelFormat: Integer;
dwStyle : DWORD; dwExStyle : DWORD; begin
FillChar(h_wc, SizeOf(h_wc), 0);
h_wc.cbSize := SizeOf(h_wc);
h_wc.style := CS_OWNDC or CS_VREDRAW or CS_HREDRAW; h_wc.lpfnWndProc := @WndProc; h_wc.hInstance := HInstance; h_wc.lpszMenuName := nil; h_wc.hCursor := LoadCursor(0, IDC_ARROW);
h_wc.lpszClassName := 'OpenGL'; WINDOWS.RegisterClassEx(h_wc);
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',APP_NAME, dwStyle, 0, 0, Width, Height, 0, 0, hInstance, nil);
h_dc := GetDC(h_wnd);
with pfd do
begin
nSize := SizeOf(TPixelFormatDescriptor); nVersion := 1; dwFlags := PFD_DOUBLEBUFFER or PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL; iPixelType := PFD_TYPE_RGBA; cColorBits := 32; 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 := 32; cStencilBits := 0; cAuxBuffers := 0; iLayerType := PFD_MAIN_PLANE; bReserved := 0; dwLayerMask := 0; dwVisibleMask := 0; dwDamageMask := 0; end;
nPixelFormat := ChoosePixelFormat( H_DC, @pfd ); SetPixelFormat( H_DC, nPixelFormat, @pfd );
h_rc := wglCreateContext(h_dc);
wglMakeCurrent(h_dc, h_rc);
if FullScreen then DoFullScreen(width, height, 32);
ShowWindow(h_wnd, SW_SHOW);
SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd);
Resize(width,height);
Init;
end;
function GetTime: integer;
var
T: LARGE_INTEGER;
F: LARGE_INTEGER;
begin
QueryPerformanceFrequency(Int64(F));
QueryPerformanceCounter(Int64(T));
Result:= Trunc(1000 * T.QuadPart / F.QuadPart);
end;
procedure ResetTimer;
begin
ups_time_old := GetTime;
end;
function FPS: integer;
begin
Result := _FPS;
end;
procedure Loop(UPS: Integer);
begin
ups_time_old := GetTime - 1000 div UPS;
ups_time := GetTime;
fps_time := GetTime;
while not finished do
begin
while PeekMessage(msg,0,0,0,PM_REMOVE) do
begin
if msg.message = WM_QUIT then finished := true else begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end;
while GetTime - ups_time_old >= (1000 div ups) do
begin
Update;
inc(ups_time_old, 1000 div ups);
end;
Draw;
SwapBuffers(h_dc);
if fps_time <= GetTime then
begin
fps_time := GetTime + 1000;
_FPS := fps_cur;
fps_cur := 0;
end;
inc(fps_cur);
SetWindowText(h_Wnd, PChar(APP_NAME + ' [' + intToStr(_FPS) + ' FPS]'));
end;
DestroyWND(false);
end;
begin
CreateAPP(1024,768, true);
Loop(500);
end.
-
> Мне нужно сдать игру до 1 октября. Может можно написать > игру в одном DPR файле как вы думаете. > ДУмаю может оставить все функии по инициализации окна и > графики. > в главном файле DPR. Как вы считаете?
Нельзя писать игру в одном DPR. Я в свое время написал один такой проект и понял что оно нафиг не надо, там черт ногму сломит. Модульности рулит.
> Тогда у меня вдальнейшем может возникнуть другая проблема, > Когда мне > например надо будет писать Спрайтовый модуль и тп. То как > мне вних > использовать такие важные переменные как h_wnd, h_dc ...
ДЛя глобальных переменных лично я использую отдельный модуль.
-
@!!ex © (28.05.07 07:43) [32]
Так что ты мне посоветуеш делать ...
-
> HARIER (28.05.07 10:08)
Мне бы кто посоветовал. $)
-
> [33] HARIER (28.05.07 10:08) > Так что ты мне посоветуеш делать ...
На конкретный вопрос - конкретный ответ... В чем именно проблема то ?
-
Да раздели код движка по модулям (привожу код своего движ): 1. Допустим главный модуль Engine: Туда напиши: var Engine : record Han : THandle; // Хэндл движка WC : TWndClassEx; // Класс окна движка MSG : MSG; // Сообщения окна движка WinParam : packed record // Структура параметров окна движка Width, Height : Word; // Ширина /Высота Hz, Bits : Byte; // Частота/Бит end; ... end; 2. WinApi - модуль создания окна, обработка сообщений, посланных Windows: uses Engine; ... function InitWin : HRESULT; begin Result := E_FAIL;
with Engine do with WC do begin ZeroMemory(@WC, SizeOf(TWndClassEx)); cbSize := SizeOf(WC); lpszClassName := 'Engine'; lpfnWndProc := @WinProc; style := CS_VREDRAW or CS_HREDRAW; hInstance := Han; hIcon := LoadIcon(Han, nil); hIconSm := LoadIcon(Han, nil); hCursor := LoadCursor(0, IDC_ARROW); hbrBackground := COLOR_WINDOW + 3; lpszMenuName := nil; cbClsExtra := 0; cbWndExtra := 0;
If RegisterClassEx(SLWC) = 0 then Exit;
Han := CreateWindowEx(0, lpszClassName, 'Engine', WS_POPUP, 0, 0, 100, 100, 0, 0, hInstance, nil);
If Han = 0 then Exit;
ShowWindow (Han, SW_SHOW); UpdateWindow(Han); end;
Result := S_OK; end; ... P.S. Строй движок по такому принципу!!!
-
У меня такие вопросы.
1. Допустим у меня такие модули Engine - таймер , установка процесов.. Window - создание окна GL - Создание контекста.
Как их обьеденить?
2. Как привильно создавать классы что бы не выскакивала Runtime error?
3. Тоесть В каждом модуле класс модуля как этот класс использовать в других модулях.
-
> Как привильно создавать классы что бы не выскакивала Runtime > error?
У меня не выскакивает... Что я делаю не так7 :)))
> Тоесть В каждом модуле класс модуля как этот класс использовать > в других модулях.
Не понял вопроса.
Вот у меня есть класс, например: TEffects = class public Player:^x_vector; Constructor Create; Procedure Add(Effect:PSimpleEffect; Position:x_vector; LifeTime:integer; HalfSize:single; const Velocity:x_vector; Color:x_vector; GlobalMove:boolean = false); overload; Procedure AddLinked(Effect:PSimpleEffect; Position:px_vector; LifeTime:integer; HalfSize:single; const Color:x_vector); Procedure Add(Effect:PSimpleEffect; Position:x_vector; LifeTime:integer; HalfSize:single; const Velocity,Accelerate:x_vector; const Color, ChangeColor:x_vector; Source:boolean; VelocityLink:px_vector; GlobalMove:boolean = false); overload; Procedure Update(dt:integer); Procedure Draw(); Procedure Clear; Procedure GlobalMove(const Vector:x_Vector); protected Items:array of TAliveEffect; Size:integer; Count:integer; end;
Описанный в модуле Effects. Использую я его очень просто: var Effects:TEffects; ... Effects:=TEffects.Create; Effects.Player:=@PlayerPosition; //Для поворота спрайтов к камере. ... Effects.Update(dt); ... Effects.Draw; ... Effects.Free;
-
Где имено создовать класс. так чтобы его можно было использовать в модулях движка.
-
У меня есть главный класс движка, который рулит всем. Вот в нем я и создаю почти все объекты.
-
Нашел почему глюк. :) Я не очищал буфера в glClear во время рисования :)
|