[Delphi][OpenGL] Klasa tworząca okno

[Brainer]

Witam.

 

Mam problem z klasą, której zadaniem jest tworzenie okna dla OpenGL. Oto kod:

CODEunit UBEOGLWindow;

 

interface

 

(*

 

Póki nie ma klasy kamery, parametry w "DoResizeWnd"

są z góry narzucone.

 

*)

 

uses

Classes, Windows, Messages,

// -- Headers --

dglOpenGL,

// -- Engine Units --

UBELogger;

 

type

{ .: TKeyboardEvent :. }

TKeyboardEvent = procedure(KeyCode: Byte) of object;

 

{ .: TOGLWindow :. }

TOGLWindow = class(TObject)

private

{ Private declarations }

FWnd: HWND;

FDC: HDC;

FRC: HGLRC;

//FKeys: array[0..255] of Boolean;

 

FCaption: String;

FWidth: Integer;

FHeight: Integer;

FFullScreen: Boolean;

FPixelDepth: Integer;

 

FOnInitOpenGL, FOnDraw: TNotifyEvent;

FOnKeyDown, FOnKeyUp: TKeyboardEvent;

FWindowProc, FWindowProcNew: Pointer;

protected

{ Protected declarations }

procedure WndProc(var AMessage: TMessage);

function glCreateWnd(Width, Height: Integer; FullScreen: Boolean;

PixelDepth: Integer): Boolean;

procedure glKillWnd(FullScreen: Boolean);

 

procedure DoResizeWnd(Width, Height: Integer);

public

{ Public declarations }

constructor Create();

destructor Destroy(); override;

 

function CreateOpenGLWindow(): Boolean;

 

property OnInitOpenGL: TNotifyEvent read FOnInitOpenGL write FOnInitOpenGL;

property OnDraw: TNotifyEvent read FOnDraw write FOnDraw;

property OnKeyDown: TKeyboardEvent read FOnKeyDown write FOnKeyDown;

property OnKeyUp: TKeyboardEvent read FOnKeyUp write FOnKeyUp;

 

property Caption: String read FCaption write FCaption;

property Width: Integer read FWidth write FWidth;

property Height: Integer read FHeight write FHeight;

property FullScreen: Boolean read FFullScreen write FFullScreen;

property PixelDepth: Integer read FPixelDepth write FPixelDepth;

end;

 

var

OGLWindow: TOGLWindow;

 

function WinMain(hInstance: HINST; hPrevInstance: HINST; lpCmdLine: PChar;

nCmdShow: Integer): Integer; stdcall;

 

implementation

 

{ .: WinMain :. }

function WinMain(hInstance: HINST; hPrevInstance: HINST; lpCmdLine: PChar;

nCmdShow: Integer): Integer; stdcall;

var

msg: TMsg;

finished: Boolean;

begin

finished := False;

 

if not OGLWindow.CreateOpenGLWindow() then

begin

Result := 0;

exit;

end;

 

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

if Assigned(OGLWindow.FOnDraw) then

OGLWindow.OnDraw(nil);

 

SwapBuffers(OGLWindow.FDC);

end;

end;

 

OGLWindow.glKillWnd(OGLWindow.FullScreen);

Result := msg.wParam;

end;

 

{ TOGLWindow }

 

constructor TOGLWindow.Create();

begin

inherited Create();

 

FCaption := '';

FWidth := 640;

FHeight := 480;

FFullScreen := False;

FPixelDepth := 32;

 

FOnInitOpenGL := nil;

FOnDraw := nil;

FOnKeyDown := nil;

FOnKeyUp := nil;

 

FWindowProcNew := MakeObjectInstance(WndProc);

FWindowProc := Pointer(SetWindowLong(FWnd, GWL_WNDPROC,

Integer(FWindowProcNew)));

end;

 

function TOGLWindow.CreateOpenGLWindow(): Boolean;

begin

Result := glCreateWnd(FWidth, FHeight, FFullScreen, FPixelDepth);

end;

 

destructor TOGLWindow.Destroy();

begin

SetWindowLong(FWnd, GWL_WNDPROC, Integer(FWindowProc));

 

inherited Destroy();

end;

 

procedure TOGLWindow.DoResizeWnd(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);

 

FWidth := Width;

FHeight := Height;

 

glMatrixMode(GL_MODELVIEW);

glLoadIdentity();

end;

 

function TOGLWindow.glCreateWnd(Width, Height: Integer; FullScreen: Boolean;

PixelDepth: Integer): Boolean;

var

wndClass: TWndClass;

dwStyle, dwExStyle: DWORD;

dmScreenSettings: DEVMODE;

PixelFormat: Cardinal;

h_Instance: HINST;

pfd: TPIXELFORMATDESCRIPTOR;

begin

h_Instance := GetModuleHandle(nil);

ZeroMemory(@wndClass, SizeOf(wndClass));

 

with wndClass do

begin

style := CS_HREDRAW or CS_VREDRAW or CS_OWNDC;

lpfnWndProc := FWindowProc;

hInstance := h_Instance;

hCursor := LoadCursor(0, IDC_ARROW);

lpszClassName := 'OpenGL';

end;

 

if (RegisterClass(wndClass) = 0) then

begin

Log.LogError('Failed to register the window class!', 'UBECore');

Result := False;

exit;

end;

 

if FullScreen then

begin

ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));

with dmScreenSettings do

begin

dmSize := SizeOf(dmScreenSettings);

dmPelsWidth := Width;

dmPelsHeight := Height;

dmBitsPerPel := PixelDepth;

dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;

end;

 

if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) =

DISP_CHANGE_FAILED) then

begin

Log.LogError('Unable to switch to fullscreen!', 'UBECore');

FullScreen := False;

end;

end;

 

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;

 

FWnd := CreateWindowEx(dwExStyle, 'OpenGL', PChar(FCaption), dwStyle, 0, 0,

Width, Height, 0, 0, h_Instance, nil);

if (FWnd = 0) then

begin

glKillWnd(FFullScreen);

Log.LogError('Unable to create window!', 'UBECore');

Result := False;

exit;

end;

 

FDC := GetDC(FWnd);

if (FDC = 0) then

begin

glKillWnd(FullScreen);

Log.LogError('Unable to get a device context!', 'UBECore');

Result := False;

exit;

end;

 

//ZeroMemory(@pfd, SizeOf(TPIXELFORMATDESCRIPTOR));

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 := PixelDepth;

{

cRedBits := 0; // Number of red bitplanes

cRedShift := 0; // Shift count for red bitplanes

cGreenBits := 0; // Number of green bitplanes

cGreenShift := 0; // Shift count for green bitplanes

cBlueBits := 0; // Number of blue bitplanes

cBlueShift := 0; // Shift count for blue bitplanes

cAlphaBits := 0; // Not supported

cAlphaShift := 0; // Not supported

cAccumBits := 0; // No accumulation buffer

cAccumRedBits := 0; // Number of red bits in a-buffer

cAccumGreenBits := 0; // Number of green bits in a-buffer

cAccumBlueBits := 0; // Number of blue bits in a-buffer

cAccumAlphaBits := 0; // Number of alpha bits in a-buffer

}

cDepthBits := 16;

{

cStencilBits := 0; // Turn off stencil buffer

cAuxBuffers := 0; // Not supported

}

iLayerType := PFD_MAIN_PLANE;

{

bReserved := 0; // Number of overlay and underlay planes

dwLayerMask := 0; // Ignored

dwVisibleMask := 0; // Transparent color of underlay plane

dwDamageMask := 0; // Ignored

}

end;

 

PixelFormat := ChoosePixelFormat(FDC, @pfd);

if (PixelFormat = 0) then

begin

glKillWnd(FullScreen);

Log.LogError('Unable to find a suitable pixel format', 'UBECore');

Result := False;

Exit;

end;

 

if not SetPixelFormat(FDC, PixelFormat, @pfd) then

begin

glKillWnd(FullScreen);

Log.LogError('Unable to set the pixel format', 'UBECore');

Result := False;

exit;

end;

 

FRC := wglCreateContext(FDC);

if (FRC = 0) then

begin

glKillWnd(FullScreen);

Log.LogError('Unable to create an OpenGL rendering context', 'UBECore');

Result := False;

exit;

end;

 

if not wglMakeCurrent(FDC, FRC) then

begin

glKillWnd(FullScreen);

Log.LogError('Unable to activate OpenGL rendering context', 'UBECore');

Result := False;

exit;

end;

 

ShowWindow(FWnd, SW_SHOW);

SetForegroundWindow(FWnd);

SetFocus(FWnd);

 

DoResizeWnd(FWidth, FHeight);

if Assigned(FOnInitOpenGL) then

FOnInitOpenGL(Self);

 

Result := True;

end;

 

procedure TOGLWindow.glKillWnd(FullScreen: Boolean);

begin

if FullScreen then

begin

ChangeDisplaySettings(DEVMODE(nil^), 0);

ShowCursor(True);

end;

 

if not wglMakeCurrent(FDC, 0) then

Log.LogError('Release of DC and RC failed!', 'UBECore');

 

if not wglDeleteContext(FRC) then

begin

Log.LogError('Release of rendering context failed!', 'UBECore');

FRC := 0;

end;

 

if (FDC > 0) and (ReleaseDC(FWnd, FDC) = 0) then

begin

Log.LogError('Release of device context failed!', 'UBECore');

FDC := 0;

end;

 

if (FWnd 0) and (not DestroyWindow(FWnd)) then

begin

Log.LogError('Unable to destroy window!', 'UBECore');

FWnd := 0;

end;

 

if not UnregisterClass('OpenGL', hInstance) then

begin

Log.LogError('Unable to unregister window class!', 'UBECore');

hInstance := 0;

end;

end;

 

procedure TOGLWindow.WndProc(var AMessage: TMessage);

begin

with AMessage do

case Msg of

WM_CLOSE:

begin

PostQuitMessage(0);

Result := 0;

end;

WM_SIZE:

begin

DoResizeWnd(LOWORD(lParam), HIWORD(lParam));

Result := 0;

end;

else

Result := CallWindowProc(FWindowProc, FWnd, Msg, wParam, lParam);

end;

end;

 

initialization

OGLWindow := TOGLWindow.Create();

 

finalization

OGLWindow.Free();

OGLWindow := nil;

 

end.

 

Nie wiem dlaczego, ale dostaję AV po wywołaniu CreateWindowEx. Byłbym bardzo wdzięczny za wykazanie mi, co robię źle.

 

Pozdrawiam!

[Nvm]

Albo mi się coś źle wyświetla, albo nie używasz tagów Delphi. Przesuwanie kodu w takim okienku, bez kolorowania, jest nie wygodne <_ a do tworzenia okna polecam sdl src="%7B___base_url___%7D/uploads/emoticons/default_happy.png" alt="^_^">

[Brainer]

Bo używam tagu codebox, bo miejsca można zaoszczędzić. No ja używałbym SDLa, ale miałem z tym problem (nie obsługiwał mi ciągle wciśniętego przycisku - reagował tylko na ciągłe wciskanie i puszczanie). Ale mimo to wolałbym jednak używać tej klasy - no chyba, że ktoś wskaże mi, jak poprawnie obługiwać SDLa (ale też z poziomu klasy, a nie procedur!).

[Nvm]

No ja używałbym SDLa, ale miałem z tym problem (nie obsługiwał mi ciągle wciśniętego przycisku - reagował tylko na ciągłe wciskanie i puszczanie).

 

Też miałem z początku taki problem. Ale na Warsztacie znalazłem solucję - zrób tablicę booleanów i zmieniaj wartości podczas wciskania klawiszy

[TSr]

CYTAT(Brainer @ nie, 06 sty 2008 - 07:59) No ja używałbym SDLa, ale miałem z tym problem (nie obsługiwał mi ciągle wciśniętego przycisku - reagował tylko na ciągłe wciskanie i puszczanie).

Kto to zgadnie w jaki sposób to obsługiwałeś... Dla przykładu można zrobić tak, że jak dostaniesz sygnał o tym, że naciśnięty jest klawisz to zapamiętujesz to w jakiejś zmiennej typu Boolean, a jeśli zostanie puszczony to zmieniasz tę zmienną - działa na 100%.

 

chyba, że ktoś wskaże mi, jak poprawnie obługiwać SDLa (ale też z poziomu klasy, a nie procedur!).

Trzeba sobie klasę napisać jeśli koniecznie chcesz ją mieć. SDLa używa się zawsze tak samo niezależnie czy funkcje wywołujesz z poziomu metod klasy czy zwykłych procedur.

[Brainer]

CYTAT(TSr @ nie, 06 sty 2008 - 12:20)

Kto to zgadnie w jaki sposób to obsługiwałeś... Dla przykładu można zrobić tak, że jak dostaniesz sygnał o tym, że naciśnięty jest klawisz to zapamiętujesz to w jakiejś zmiennej typu Boolean, a jeśli zostanie puszczony to zmieniasz tę zmienną - działa na 100%.

 

Miałem dokładnie tak, jak napisałeś Ty i Nvm. Ale gdy trzymałem np. strzałkę w górę, to obiekt nie przesuwał się do przodu cały czas, tylko raz (w momencie wciśnięcia klawisza).

Trzeba sobie klasę napisać jeśli koniecznie chcesz ją mieć. SDLa używa się zawsze tak samo niezależnie czy funkcje wywołujesz z poziomu metod klasy czy zwykłych procedur.

A to mnie bardzo cieszy! Bo z tego co widzę, używanie WinAPI w klasach to jest trochę co innego.

[TSr]

Miałem dokładnie tak, jak napisałeś Ty i Nvm. Ale gdy trzymałem np. strzałkę w górę, to obiekt nie przesuwał się do przodu cały czas, tylko raz (w momencie wciśnięcia klawisza).

 

Może zmienne Boolean miałeś, ale to nie wszystko. Jeśli w głównej pętli miałeś coś takiego: if strzalka_w_gore then y := y+1;, gdzie strzalka_w_gore to zmienna Boolean, to co tu ma nie działać?

[Brainer]

Może zmienne Boolean miałeś, ale to nie wszystko. Jeśli w głównej pętli miałeś coś takiego: if strzalka_w_gore then y := y+1;, gdzie strzalka_w_gore to zmienna Boolean, to co tu ma nie działać?

No właśnie nie wiem za bardzo. Ale mniejsza o to, bardziej chciałbym, żeby ta moja klasa działała. Macie jakieś wskazówki, co może być nie tak?

 

EDIT Okej, dałem sobie radę.