| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Проблемы с OpenGL [Delphi, Windows]

Страницы:   < 1 2 3 >

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.

---

@!!ex   (2007-05-25 21:30:00) [41]

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

---

Страницы:   < 1 2 3 >

Наверх