111 lines
4.3 KiB
ObjectPascal
111 lines
4.3 KiB
ObjectPascal
|
||
//*****************************************************************************************************\\
|
||
// Copyright (©) Sergey Latchenko ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
|
||
// This code is distributed under the Unlicense
|
||
// For details see LICENSE file or this:
|
||
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
|
||
//*****************************************************************************************************\\
|
||
// Copyright (©) Сергей Латченко ( github.com/SunSerega | forum.mmcs.sfedu.ru/u/sun_serega )
|
||
// Данный код распространяется с лицензией Unlicense
|
||
// Подробнее в файле LICENSE или тут:
|
||
// https://github.com/SunSerega/POCGL/blob/master/LICENSE
|
||
//*****************************************************************************************************\\
|
||
|
||
///
|
||
///Модуль, зарезервированный для высокоуровневой оболочки модуля OpenGL
|
||
///Все текущие элементы модуля являются временными
|
||
///
|
||
unit OpenGLABC;
|
||
|
||
uses System;
|
||
uses OpenGL;
|
||
|
||
type
|
||
|
||
///Методы для интеграции с gdi
|
||
gl_gdi = static class
|
||
{$reference System.Windows.Forms.dll}
|
||
|
||
///Создаёт новый контекст устройства GDI для дескриптора элемента управления
|
||
public static function GetControlDC(hwnd: IntPtr): gdi_device_context;
|
||
external 'user32.dll' name 'GetDC';
|
||
|
||
///Создаёт и настраивает контекст устройства GDI элемента управления WF
|
||
///hwnd - дескриптор элемента управления
|
||
public static function InitControl(hwnd: IntPtr): gdi_device_context;
|
||
begin
|
||
Result := gl_gdi.GetControlDC(hwnd);
|
||
|
||
var pfd: gdi_pixel_format_descriptor;
|
||
pfd.nVersion := 1;
|
||
|
||
pfd.dwFlags :=
|
||
GDI_PixelFormatFlags.DRAW_TO_WINDOW or
|
||
GDI_PixelFormatFlags.SUPPORT_OPENGL or
|
||
GDI_PixelFormatFlags.DOUBLEBUFFER
|
||
;
|
||
pfd.cColorBits := 24;
|
||
pfd.cDepthBits := 16;
|
||
|
||
if not gdi.SetPixelFormat(
|
||
Result,
|
||
gdi.ChoosePixelFormat(Result, pfd),
|
||
pfd
|
||
) then raise new InvalidOperationException;
|
||
|
||
end;
|
||
|
||
///Создаёт и настраивает контекст устройства GDI элемента управления WF
|
||
public static function InitControl(c: System.Windows.Forms.Control) := InitControl(c.Handle);
|
||
|
||
end;
|
||
|
||
RedrawThreadProc = procedure(pl: PlatformLoader; EndFrame: ()->());
|
||
RedrawHelper = static class
|
||
|
||
///Создаёт новый поток выполнения, который:
|
||
///1. Создаёт контекст OpenGL из контекста устройства GDI (hdc)
|
||
///2. Запускает перерисовку (RedrawThreadProc)
|
||
public static procedure SetupRedrawThread(hdc: gdi_device_context; RedrawThreadProc: OpenGLABC.RedrawThreadProc; vsync_fps: integer := 65);
|
||
begin
|
||
|
||
System.Threading.Thread.Create(()->
|
||
begin
|
||
|
||
var pl := new PlWin;
|
||
|
||
var context := wgl.CreateContext(hdc);
|
||
if not wgl.MakeCurrent(hdc, context) then raise new InvalidOperationException('Не удалось применить контекст');
|
||
|
||
var EndFrame: ()->();
|
||
if vsync_fps<=0 then
|
||
EndFrame := ()->gdi.SwapBuffers(hdc) else
|
||
begin
|
||
var LastRedr := DateTime.UtcNow;
|
||
var FrameDuration := new TimeSpan(Trunc(TimeSpan.TicksPerSecond/vsync_fps));
|
||
var MaxSlowDown := FrameDuration.Ticks*3;
|
||
|
||
EndFrame := ()->
|
||
begin
|
||
gdi.SwapBuffers(hdc);
|
||
|
||
LastRedr := LastRedr+FrameDuration;
|
||
var time_left := LastRedr-DateTime.UtcNow;
|
||
|
||
if time_left.Ticks>0 then
|
||
System.Threading.Thread.Sleep(time_left) else
|
||
if -time_left.Ticks > MaxSlowDown then
|
||
LastRedr := LastRedr.AddTicks(-time_left.Ticks - MaxSlowDown);
|
||
|
||
end;
|
||
|
||
end;
|
||
|
||
RedrawThreadProc(pl, EndFrame);
|
||
end).Start;
|
||
|
||
end;
|
||
|
||
end;
|
||
|
||
end. |