Delphi의 OpenGL 컨트롤
unit OpenGLWinControl;
interface
uses System.SysUtils, System.Classes, Vcl.Controls, Winapi.Messages,
Winapi.OpenGL, Winapi.Windows;
type
TDebugEvent = procedure(Sender: TObject; Info: string; Level: integer)
of object;
TOpenGLWinControl = class(TWinControl)
public
HandleOfDeviceContex: HDC;
HandleOfGLRenderContex: HGLRC;
private
fOnSetPixelFormatDescriptor: TNotifyEvent;
fOnPaint: TNotifyEvent;
fDebugEvent: TDebugEvent;
{ Private declarations }
procedure WMCreate(var Message: TWMCreate); message WM_CREATE;
procedure WMDestroy(var Message: TWMDestroy); message WM_DESTROY;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
protected
{ Protected declarations }
procedure AppendLog(txt: string);
published
{ Public declarations }
property OnSetPixelFormatDescriptor: TNotifyEvent
read fOnSetPixelFormatDescriptor write fOnSetPixelFormatDescriptor;
property OnPaint: TNotifyEvent read fOnPaint write fOnPaint;
public
procedure Render();
published
{ Published declarations }
//
property OnMouseDown;
property OnMouseUp;
property OnMouseMove;
property OnMouseWheelDown;
property OnMouseWheelUp;
//
property OnResize;
//
property Align;
published
//
property OnDebugEvent: TDebugEvent read fDebugEvent write fDebugEvent;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('OpenGL', [TOpenGLWinControl]);
end;
{ TOpenGLWinControl }
procedure TOpenGLWinControl.AppendLog(txt: string);
begin
if Assigned(self.fDebugEvent) then begin
fDebugEvent(self, txt, 0);
end;
end;
procedure TOpenGLWinControl.Render;
begin
wglMakeCurrent(HandleOfDeviceContex, HandleOfGLRenderContex);
if Assigned(fOnPaint) then begin
fOnPaint(self);
end;
end;
procedure TOpenGLWinControl.WMCreate(var Message: TWMCreate);
var next: boolean;
begin
inherited;
next := not(csDesigning in ComponentState);
if next then begin
HandleOfDeviceContex := GetDC(self.Handle);
next := HandleOfDeviceContex <> 0;
end;
if next then begin
next := Assigned(fOnSetPixelFormatDescriptor);
end;
if next then begin
fOnSetPixelFormatDescriptor(self);
HandleOfGLRenderContex := wglCreateContext(HandleOfDeviceContex);
next := HandleOfGLRenderContex <> 0;
end;
end;
procedure TOpenGLWinControl.WMDestroy(var Message: TWMDestroy);
begin
inherited;
if not(csDesigning in ComponentState) then begin
wglMakeCurrent(0, 0);
wglDeleteContext(HandleOfGLRenderContex);
end;
end;
procedure TOpenGLWinControl.WMPaint(var Message: TWMPaint);
var PS: TPaintStruct; DC: HDC;
begin
if (csDesigning in ComponentState) then begin
inherited;
end else begin
// inherited;
try
DC := BeginPaint(Handle, PS);
EndPaint(Handle, PS);
self.Render;
// DC := BeginPaint(Handle, PS);
finally
end;
end;
end;
procedure TOpenGLWinControl.WMSize(var Message: TWMSize);
var w, h: integer; aspect: GLfloat;
begin
if not(csDesigning in ComponentState) then begin
w := self.Width;
h := self.Height;
glViewport(0, 0, w, h);
glMatrixMode(GL_PROJECTION);
glLoadIdentity();
//
aspect := w;
aspect := aspect / h;
gluPerspective(30.0, aspect, 1.0, 50.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity();
end;
inherited;
end;
end.
테스트 프로그램 소스는 다음과 같습니다.
unit main;
interface
uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
OpenGLWinControl, Winapi.OpenGL, Vcl.ExtCtrls;
type
TfrmMain = class(TForm)
opnglwncntrl1: TOpenGLWinControl;
tmr: TTimer;
procedure opnglwncntrl1SetPixelFormatDescriptor(Sender: TObject);
procedure opnglwncntrl1Paint(Sender: TObject);
procedure tmrTimer(Sender: TObject);
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var frmMain: TfrmMain;
implementation
{$R *.dfm}
procedure TfrmMain.FormPaint(Sender: TObject);
begin
self.opnglwncntrl1.Render;
end;
procedure TfrmMain.opnglwncntrl1Paint(Sender: TObject);
begin
glClearColor(0.0, 0.0, 0.0, 1.0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
SwapBuffers(wglGetCurrentDC);
end;
procedure TfrmMain.opnglwncntrl1SetPixelFormatDescriptor(Sender: TObject);
const pfd: TPIXELFORMATDESCRIPTOR = (nSize: sizeof(TPIXELFORMATDESCRIPTOR);
// size
nVersion: 1; // version
dwFlags: PFD_SUPPORT_OPENGL or PFD_DRAW_TO_WINDOW or PFD_DOUBLEBUFFER;
// support double-buffering
iPixelType: PFD_TYPE_RGBA; // color type
cColorBits: 24; // preferred color depth
cRedBits: 0; cRedShift: 0; // color bits (ignored)
cGreenBits: 0; cGreenShift: 0; cBlueBits: 0; cBlueShift: 0; cAlphaBits: 0;
cAlphaShift: 0; // no alpha buffer
cAccumBits: 0; cAccumRedBits: 0; // no accumulation buffer,
cAccumGreenBits: 0; // accum bits (ignored)
cAccumBlueBits: 0; cAccumAlphaBits: 0; cDepthBits: 16; // depth buffer
cStencilBits: 0; // no stencil buffer
cAuxBuffers: 0; // no auxiliary buffers
iLayerType: PFD_MAIN_PLANE; // main layer
bReserved: 0; dwLayerMask: 0; dwVisibleMask: 0; dwDamageMask: 0;
// no layer, visible, damage masks
);
var PixelFormat: Integer; r: Boolean;
begin
ZeroMemory(@pfd, sizeof(PIXELFORMATDESCRIPTOR));
PixelFormat := ChoosePixelFormat(opnglwncntrl1.HandleOfDeviceContex, @pfd);
r := SetPixelFormat(opnglwncntrl1.HandleOfDeviceContex, PixelFormat, @pfd);
end;
procedure TfrmMain.tmrTimer(Sender: TObject);
begin
self.opnglwncntrl1.Render;
end;
end.
인터페이스는 다음과 같습니다.
object frmMain: TfrmMain
Left = 0
Top = 0
Caption = 'OpenGL'#31243#24207#28436#31034
ClientHeight = 665
ClientWidth = 965
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnPaint = FormPaint
PixelsPerInch = 96
TextHeight = 13
object opnglwncntrl1: TOpenGLWinControl
Left = 176
Top = 72
Width = 441
Height = 321
OnSetPixelFormatDescriptor = opnglwncntrl1SetPixelFormatDescriptor
OnPaint = opnglwncntrl1Paint
end
object tmr: TTimer
Enabled = False
Interval = 1
OnTimer = tmrTimer
Left = 808
Top = 176
end
end
이 내용에 흥미가 있습니까?
현재 기사가 여러분의 문제를 해결하지 못하는 경우 AI 엔진은 머신러닝 분석(스마트 모델이 방금 만들어져 부정확한 경우가 있을 수 있음)을 통해 가장 유사한 기사를 추천합니다:
다양한 언어의 JSONJSON은 Javascript 표기법을 사용하여 데이터 구조를 레이아웃하는 데이터 형식입니다. 그러나 Javascript가 코드에서 이러한 구조를 나타낼 수 있는 유일한 언어는 아닙니다. 저는 일반적으로 '객체'{}...
텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
CC BY-SA 2.5, CC BY-SA 3.0 및 CC BY-SA 4.0에 따라 라이센스가 부여됩니다.