| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Проблемы с OpenGL [Delphi, Windows]
HARIER © (2007-05-25 20:43:00)Почему дёргается экран. Когда передвигаю мышку или нажимаю любую клавишу.
Такое творится только при разрешении 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.
HARIER (2007-05-29 13:03:00) [1]Нашел почему глюк. :)
Я не очищал буфера в glClear во время рисования :)
@!!ex_ (2007-05-29 07:51:00) [2]У меня есть главный класс движка, который рулит всем. Вот в нем я и создаю почти все объекты.
HARIER (2007-05-29 00:38:00) [3]Где имено создовать класс. так чтобы его можно было использовать в модулях движка.
@!!ex (2007-05-28 19:30:00) [4]> Как привильно создавать классы что бы не выскакивала 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;
HARIER (2007-05-28 19:14:00) [5]У меня такие вопросы.
1. Допустим у меня такие модули
Engine - таймер , установка процесов..
Window - создание окна
GL - Создание контекста.
Как их обьеденить?
2. Как привильно создавать классы что бы не выскакивала Runtime error?
3. Тоесть В каждом модуле класс модуля как этот класс использовать в других модулях.
ElectriC (2007-05-28 15:28:00) [6]Да раздели код движка по модулям (привожу код своего движ):
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. Строй движок по такому принципу!!!
Rial (2007-05-28 12:35:00) [7]> [33] HARIER (28.05.07 10:08)
> Так что ты мне посоветуеш делать ...
На конкретный вопрос - конкретный ответ...
В чем именно проблема то ?
@!!ex (2007-05-28 10:18:00) [8]> HARIER (28.05.07 10:08)
Мне бы кто посоветовал. $)
HARIER (2007-05-28 10:08:00) [9]@!!ex © (28.05.07 07:43) [32]
Так что ты мне посоветуеш делать ...
@!!ex (2007-05-28 07:43:00) [10]> Мне нужно сдать игру до 1 октября. Может можно написать
> игру в одном DPR файле как вы думаете.
> ДУмаю может оставить все функии по инициализации окна и
> графики.
> в главном файле DPR. Как вы считаете?
Нельзя писать игру в одном DPR.
Я в свое время написал один такой проект и понял что оно нафиг не надо, там черт ногму сломит.
Модульности рулит.
> Тогда у меня вдальнейшем может возникнуть другая проблема,
> Когда мне
> например надо будет писать Спрайтовый модуль и тп. То как
> мне вних
> использовать такие важные переменные как h_wnd, h_dc ...
ДЛя глобальных переменных лично я использую отдельный модуль.
HARIER (2007-05-28 01:11:00) [11]
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура создаёт окно и инициализирует OpenGL }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure CreateAPP(width, height: integer; FullScreen: Boolean = false);
var
pfd: TPixelFormatDescriptor;
nPixelFormat: Integer;
dwStyle : DWORD; // Window styles
dwExStyle : DWORD; // Extended window styles
begin
// Заполнить структуру h_wc нулями
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; // отсутствие меню (nil)
h_wc.hCursor := LoadCursor(0, IDC_ARROW); // устанавливаем стандартный курсор
// h_wc.hbrBackground := COLOR_BTNFACE+1; // цвет окна
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; // число битовых плоскостей красного в каждом буфере RGBA
cRedShift := 0; // смещение от начала числа битовых плоскостей красного в каждом буфере RGBA
cGreenBits := 0; // число битовых плоскостей зелёного в каждом буфере RGBA
cGreenShift := 0; // смещение от начала числа битовых плоскостей зелёного в каждом буфере RGBA
cBlueBits := 0; // число битовых плоскостей синего в каждом буфере RGBA
cBlueShift := 0; // смещение от начала числа битовых плоскостей синего в каждом буфере RGBA
cAlphaBits := 0; // число битовых плоскостей альфа в каждом буфере RGBA
cAlphaShift := 0; // смещение от начала числа битовых плоскостей альфа в каждом буфере RGBA
cAccumBits := 0; // общее число битовых плоскостей в буфере аккумулятора
cAccumRedBits := 0; // число битовых плоскостей красного в буфере аккумулятора
cAccumGreenBits := 0; // число битовых плоскостей зелёного в буфере аккумулятора
cAccumBlueBits := 0; // число битовых плоскостей синего в буфере аккумулятора
cAccumAlphaBits := 0; // число битовых плоскостей альфа в буфере аккумулятора
cDepthBits := 32; // размер буфера глубины (ось z)
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;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Функция получает FPS }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
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.
HARIER (2007-05-28 01:10:00) [12]
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Процедура инициализации }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
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); // Установить порт просмотра OpenGL
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 нулями
dm.dmSize := SizeOf(DevMode); // Устанавливаем размер dm
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;
HARIER (2007-05-28 01:08:00) [13]Так ни чего и не получилось.
Посмотрел свои старые проекты делал 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
ups_time_old: integer;
ups_time: integer;
// FPS
fps_time: Integer;
fps_cur: Integer;
_FPS: integer;
Time, Time_delta: integer;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
{ Функция переводит Integer -> String }
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
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);
{
Parameters:
eyex, eyey, eyez
The position of the eye point.
centerx, centery, centerz
The position of the reference point.
upx, upy, upz
The direction of the up vector.
}
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;
//roll, pitch, heading, planex, planey, planez: GLFloat
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;
// distance, twist, elevation, azimuth
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; // Завершаем программу если нажата клавиша esc
end;
ElectriC (2007-05-27 03:48:00) [14]1. Могу предположить что [25] поможет!
Так-как в твоём случае перерисовка экрана присходит тока тогда, когда
курсор мыши ползает по экрану!
2. ValidateRect(h_wnd,nil); - не нужен!
3. WM_CREATE: begin// eFinished := false; end; - не нужен!
ElectriC (2007-05-27 03:26:00) [15]
> HARIER
Совет - не спеши!!! Обдумай всё заранее!!!
Когда я писал движок > http://slil.ru/24404040/874845188/School_54.rar< (хотя и сейчас продолжаю писать) смотрел больше на исходники, а в меньше
степени - на книги (Хотя старался совмещать и то и другое).
Я погляжу, что можно сделать!
HARIER (2007-05-27 03:20:00) [16]ElectriC © (27.05.07 03:14) [25]
Учту. :-)
Посмотри на код может я чтото еще не праввильно делаю.
Напиши что имено. Я исправлю.
Завтра с утра начну заново писать.
Как думаешь лучше смотреть на исходники или в книгу.
ElectriC (2007-05-27 03:14:00) [17]вообще-то в 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;
HARIER (2007-05-27 03:12:00) [18]код файла 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.
ElectriC (2007-05-27 03:09:00) [19]Приведи исходник .dpr файла.
ElectriC (2007-05-27 03:08:00) [20]Приведи листинг основного файла (.dpr).
| |
Страницы: 