- Код: Выделить всё
WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
как этого избежать?
- Код: Выделить всё
{$MODE objfpc}{$H+}
//{$APPTYPE GUI}
program ogl_fpc_source01;
uses
{$ifdef windows}
windows,
{$endif}
gl, glu;
var
msg : TMSG; // Windows messages
hWindow : HWnd; // Windows Handle to the OGL Window
dcWindow : hDc; // Device Context for the OGL Window
rcWindow : HGLRC; // Render Context for the OGL Window
width, height, bits : longint;
fullscreen, active : boolean;
// Simple OGL initialisation for testing. //
procedure OpenGL_Init();
begin
glShadeModel(GL_SMOOTH);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
glClearColor( 0.0, 0.0, 0.0, 1.0 );
// glTranslatef(0.0, 0.0, 0.0);
end;
function OpenGL_Render() : boolean;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
{ draw here }
glClear( GL_COLOR_BUFFER_BIT );
glLoadIdentity();
glTranslatef(0.9,0.0,0.0);
glBegin( GL_TRIANGLES );
glColor3f(1.0, 0.0, 0.0);
glVertex3f(0.0, 1.0, 0.0);
glColor3f(0.0, 1.0, 0.0);
glVertex3f(-1.0, -1.0, 0.0);
glColor3f(0.0, 0.0, 1.0);
glVertex3f(1.0, -1.0, 0.0);
glEnd();
swapBuffers( dcWindow ); // put opengl stuff to screen
result := true;
end;
procedure OpenGL_Resize(width : integer; height : integer);
begin
if (Height = 0) then
Height := 1;
glViewport(0, 0, width, height);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
//gluPerspective(45.0,Width/Height,0.1,100.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;
// Try, Throw, Catch mechanism. Simple proc to display given errors. //
procedure ThrowError(pcErrorMessage : pChar);
begin
MessageBox(0, pcErrorMessage, 'Error', MB_OK);
Halt(0);
end;
// Standard WinProc. Handles all the messages from the System. //
function GLWndProc(Window: HWnd; AMessage, WParam, LParam: Longint): Longint; stdcall; export;
begin
GLWndProc := 0;
case amessage of
wm_create:
begin
active := true; // if GL Window was created correctly, then set
exit; // active-flag to "true".
end;
wm_paint:
begin
exit; // nothing to paint to Windows as we do all drawing with OGL
end;
wm_size:
begin
OpenGL_Resize(LOWORD(lParam), HIWORD(lParam));
active := true;
exit;
end;
wm_move:
begin
writeln('move window');
exit;
end;
wm_keydown:
begin
if wParam = VK_ESCAPE then
SendMessage(hWindow,wm_destroy,0,0);
exit; // check for ESC key. If pressed, then send quit message
end;
wm_destroy:
begin
active := false; // if quit message was sent, exit the main loop by setting
PostQuitMessage(0); // the active-flag to "false".
exit;
end;
wm_syscommand: // system wants something..
begin
case (wParam) of
SC_SCREENSAVE : begin // ..don't start any screensavers.
GLWndProc := 0;
end;
SC_MONITORPOWER : begin // ..and don't kill monitor power.
GLWndProc := 0;
end;
end;
end;
end;
GLWndProc := DefWindowProc(Window, AMessage, WParam, LParam); // let Windows deal with the rest of the messages.
end;
// Register the Window Class. //
function WindowRegister: Boolean;
var
WindowClass: WndClass;
begin
WindowClass.Style := cs_hRedraw or cs_vRedraw;
WindowClass.lpfnWndProc := WndProc(@GLWndProc); // Handle to our Windows messaging interface func.
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := system.MainInstance; // Get the Windows Instance for our app.
WindowClass.hIcon := LoadIcon(0, idi_Application);
WindowClass.hCursor := LoadCursor(0, idc_Arrow);
WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := 'GLWindow'; // Name the specified Window Class
WindowRegister := RegisterClass(WindowClass) <> 0;
end;
// Create the OGL Window. //
function WindowCreate(pcApplicationName : pChar): HWnd;
var
hWindow: HWnd; // Handle to Window
dmScreenSettings : DEVMODE; // Used for Full Screen Mode
begin
hWindow := CreateWindow('GLWindow',
pcApplicationName,
WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or WS_CLIPSIBLINGS,
cw_UseDefault,
cw_UseDefault,
width,
height,
0, 0,
system.MainInstance,
nil);
if hWindow <> 0 then
begin
ShowWindow(hWindow, CmdShow);
UpdateWindow(hWindow);
end;
WindowCreate := hWindow;
end;
// Init the Window and bind OGL to it. //
function WindowInit(hParent : HWnd): Boolean;
var
FunctionError : integer;
pfd : PIXELFORMATDESCRIPTOR;
iFormat : integer; // Pixel Format
begin
FunctionError := 0;
dcWindow := GetDC( hParent ); // Get Device Context
FillChar(pfd, sizeof(pfd), 0); // Define Pixel Format
pfd.nSize := sizeof(pfd);
pfd.nVersion := 1;
pfd.dwFlags := PFD_SUPPORT_OPENGL OR PFD_DRAW_TO_WINDOW OR PFD_DOUBLEBUFFER;
pfd.iPixelType := PFD_TYPE_RGBA;
pfd.cColorBits := bits;
pfd.cDepthBits := 32;
pfd.iLayerType := PFD_MAIN_PLANE;
iFormat := ChoosePixelFormat( dcWindow, @pfd ); // Create Pixel Format
if (iFormat = 0) then
FunctionError := 1;
SetPixelFormat( dcWindow, iFormat, @pfd ); // Set Pixel Format
rcWindow := wglCreateContext( dcWindow ); // Create OpenGL Context
if (rcWindow = 0) then
FunctionError := 2;
wglMakeCurrent( dcWindow, rcWindow ); // Bind OpenGL to our Window
if FunctionError = 0 then
WindowInit := true
else
WindowInit := false;
end;
// Main function to create the Window. //
function CreateOGLWindow(pcApplicationName : pChar; iApplicationWidth, iApplicationHeight, iApplicationBits : longint; bApplicationFullscreen : boolean):Boolean;
begin
width := iApplicationWidth;
height := iApplicationHeight;
bits := iApplicationBits;
fullscreen := bApplicationFullscreen;
if not WindowRegister then begin
ThrowError('Could not register the Application Window!');
CreateOGLWindow := false;
Exit;
end;
hWindow := WindowCreate(pcApplicationName);
if longint(hWindow) = 0 then begin
ThrowError('Could not create Application Window!');
CreateOGLWindow := false;
Exit;
end;
if not WindowInit(hWindow) then begin
ThrowError('Could not initialise Application Window!');
CreateOGLWindow := false;
Exit;
end;
CreateOGLWindow := true;
end;
// Kill Application Window again. //
procedure KillOGLWindow();
begin
wglMakeCurrent( dcWindow, 0 ); // Kill Device Context
wglDeleteContext( rcWindow ); // Kill Render Context
ReleaseDC( hWindow, dcWindow ); // Release Window
DestroyWindow( hWindow ); // Kill Window itself
end;
// Main Loop. //
begin
CreateOGLWindow('tura', 800, 600, 32, false);
OpenGL_Init(); // init opengl stuff
repeat // start main proc
if PeekMessage(@msg,0,0,0,0) = true then
begin
GetMessage(@msg,0,0,0);
TranslateMessage(msg);
DispatchMessage(msg);
end;
OpenGL_Render();
until active = false; // end main proc
KillOGLWindow(); // kill window stuff
end.
Может как-то надо подкрутить в GLWndProc?
- Код: Выделить всё
wm_paint:
begin
exit; // может тут вместо выхода вызывать OpenGL_Render() ?
end;
Добавлено спустя 35 минут 7 секунд:
Хм... добавил в ветку wm_paint вызов отрисовки OpenGL_render() стало получше, но всё равно моргает. Я так понимаю, функцию отрисовки вообще надо вызывать по таймеру... типа 60 раз в секунду?
