PHP DM Gate v0.9 » Проблемы с OpenGL <span class="vd">[Delphi, Windows]</span>

HARIER (25.05.07 20:43) [0]

Почему дёргается экран. Когда передвигаю мышку или нажимаю любую клавишу.
Такое творится только при разрешении 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.

<Цитата>
@!!ex © (25.05.07 21:30) [1]

Частота не поддерживаемая этим разрешением. Отсюда и косяк.
Попробуй не трогать частоту. ;)

<Цитата>
Rial © (25.05.07 22:53) [2]

Зачем вообще принудительно менять разрешение ?..
Если что то уже настроено, значит пользователю
так удобно :)

<Цитата>
homm © (25.05.07 23:09) [3]

> [2] Rial ©

+1
Конечно, если не даеться выбор разрешений по вкусу :)

<Цитата>
HARIER (26.05.07 00:28) [4]

убрал частоту не помогло.
Я двигаю мышку и тогда начинает перерисоваться экран .
Странно. Серый потом зелёный. если не двигаю мышку то нормально.
Такое только в полноекранном режиме.

<Цитата>
HARIER (26.05.07 00:31) [5]

Rial © (25.05.07 22:53) [2]

Объясни что ты имел ввиду. Я чегото непонял :-)

<Цитата>
Домик (26.05.07 02:11) [6]

> Rial © (25.05.07 22:53) [2]

У меня, к примеру, разрешение рабочего стола 1600x1200. Не каждая 3D игра будет производительна в таком разрешение, а 2D игрушки даже таких разрешений, как правило, не знают...

<Цитата>
@!!ex © (26.05.07 09:46) [7]

Может быть косяки видеокарты.
ПРишли ехешник, мы потестим на своих машинах.

<Цитата>
HARIER (26.05.07 10:28) [8]

А где я могу его выложить?

<Цитата>
HARIER (26.05.07 17:03) [9]

Вообще я думаю что то я всётаки на портачил так пробовал исходники
с сайта 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;

<Цитата>
@!!ex © (26.05.07 17:12) [10]

нафиг класс?

<Цитата>
ElectriC © (26.05.07 17:18) [11]

ИМХО, лучше так:

>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;

<Цитата>
@!!ex © (26.05.07 18:30) [12]

Почему запаковынный рекорд луычше? Медленней же работает.

<Цитата>
ElectriC © (26.05.07 19:55) [13]

> Почему запаковынный рекорд луычше? Медленней же работает.

Ну поставь обычный)))

<Цитата>
HARIER (26.05.07 20:04) [14]

А вообще Записи не нужно ни конструктора ни деструтора.
Может біть она всётаки лучше.
Что лучше делать класс движка или запись?

<Цитата>
ElectriC © (26.05.07 20:20) [15]

> А вообще Записи не нужно ни конструктора ни деструтора.

Нет.

> Что лучше делать класс движка или запись?

Ну я б лучше делал запись => быстрее и экономнее ;)))

<Цитата>
Rial © (26.05.07 20:23) [16]

> [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% шанс отправиться в корзину ежеминутно.

<Цитата>
@!!ex © (26.05.07 20:26) [17]

> У меня стоит разрешение 1024*768, частота обновление 75Гц...
> если какая то программа принудительно меняет его- это
> 80% шанс отправиться в корзину ежеминутно.

Практически любая игра меняет разрешение...
НЕ играешь чтоли совсем? :))

<Цитата>
Rial © (26.05.07 21:19) [18]

> [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)
> НЕ играешь чтоли совсем? :))

Нет...

<Цитата>
HARIER (27.05.07 03:00) [19]

Мучался весь день. И ни чего не получилось.
Мне нужно написать модуль который создаёт окно и контекст.
Первый пример я делал по книге. Своими мозгами. А второй по
исходникам с Sulaco. И что получилось выдаются ошибки:
Невозможно создать класс, создать окно ....
У меня уже голова не варит. Как нужно правильно сделать.
Получается что своими мозгами заработало но с глюками, а
метом Копировать Вставить вообще не работает.

Я думаю вы уже много раз писали подобное :-)
Помогите пожалуйста...

unit ENGINE;

interface

uses
Windows,
Messages,
OpenGL,
UTILITS;

const
ENGINE_NAME = 'ANSORO';
ENGINE_VERSION = '1.0';

type
TOnRender = procedure;
TOnUpdate = procedure;
TOnInit = procedure;

{ FOnRender: TOnRender;
FOnUpdate: TOnUpdate;
FOnInit : TOnInit;
}

{
property OnRender: TOnRender read FOnRender write FOnRender;
property OnUpdate: TOnUpdate read FOnUpdate write FOnupdate;
property OnInit: TOnInit read FOnInit write FOnInit;
}
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;

////////////////////////////////////////////////////////////////////////////////
/// Private unit function
////////////////////////////////////////////////////////////////////////////////

procedure TEngine.glInit;
begin
glClearColor(0.0, 0.0, 0.0, 0.0); // Black Background
end;

procedure glResizeWnd(Width, Height : Integer);
begin
// This Function will be handled in a later chapter

if (Height = 0) then // prevent divide by zero exception
Height := 1;
glViewport(0, 0, Width, Height); // Set the viewport for the OpenGL window
glMatrixMode(GL_PROJECTION); // Change Matrix Mode to Projection
glLoadIdentity(); // Reset View
gluPerspective(45.0, Width/Height, 1.0, 100.0); // Do the perspective calculations. Last value = max clipping depth

glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix
glLoadIdentity(); // Reset View
end;

function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case (Msg) of
WM_CREATE:
begin
// eFinished := false;
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;
else
Result := DefWindowProc(hWnd, Msg, wParam, lParam); // Default result if nothing happens
end;
end;

<Цитата>