delphi - 如何在控件中正确渲染 OpenGL？

Question

我正在尝试创建一个本质上是 OpenGL 窗口的自定义控件。

在一些设置像素格式等指南的帮助下，我已经完成了所有设置和工作(至少看起来是这样)，但是我注意到当我调整父窗体的大小时，OpenGL 图形会被缩放/拉伸(stretch)。

为了说明这一点，下图是它的外观:



表单调整大小后，现在如下所示:



忽略顶部的 OSD，因为这是我使用的屏幕录像机软件的一部分，它也会失真。

在这里，我添加了一个 Gif，以更好地演示调整窗体大小时发生的情况:



这是我的自定义控件的单位:

unit OpenGLControl;

interface

uses
  Winapi.Windows,
  System.SysUtils,
  System.Classes,
  Vcl.Controls;

type
  TOpenGLControl = class(TCustomControl)
  private
    FDC: HDC;
    FRC: HGLRC;
    FOnPaint: TNotifyEvent;
  protected
    procedure SetupPixelFormat;
    procedure GLInit;
    procedure GLRelease;

    procedure CreateHandle; override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  end;

implementation

uses
  OpenGL;

{ TOpenGLControl }

constructor TOpenGLControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TOpenGLControl.Destroy;
begin
  GLRelease;
  inherited Destroy;
end;

procedure TOpenGLControl.CreateHandle;
begin
  inherited;
  GLInit;
end;

procedure TOpenGLControl.SetupPixelFormat;
var
  PixelFormatDescriptor: TPixelFormatDescriptor;
  pfIndex: Integer;
begin
  with PixelFormatDescriptor do
  begin
    nSize := SizeOf(TPixelFormatDescriptor);
    nVersion := 1;
    dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 32;
    cRedBits := 0;
    cRedShift := 0;
    cGreenBits := 0;
    cGreenShift := 0;
    cBlueBits := 0;
    cBlueShift := 0;
    cAlphaBits := 0;
    cAlphaShift := 0;
    cAccumBits := 0;
    cAccumRedBits := 0;
    cAccumGreenBits := 0;
    cAccumBlueBits := 0;
    cAccumAlphaBits := 0;
    cDepthBits := 16;
    cStencilBits := 0;
    cAuxBuffers := 0;
    iLayerType := PFD_MAIN_PLANE;
    bReserved := 0;
    dwLayerMask := 0;
    dwVisibleMask := 0;
    dwDamageMask := 0;
  end;

  pfIndex := ChoosePixelFormat(FDC, @PixelFormatDescriptor);
  if pfIndex = 0 then Exit;

  if not SetPixelFormat(FDC, pfIndex, @PixelFormatDescriptor) then
    raise Exception.Create('Unable to set pixel format.');
end;

procedure TOpenGLControl.GLInit;
begin
  FDC := GetDC(Handle);
  if FDC = 0 then Exit;

  SetupPixelFormat;

  FRC := wglCreateContext(FDC);
  if FRC = 0 then Exit;

  if not wglMakeCurrent(FDC, FRC) then
    raise Exception.Create('Unable to initialize.');
end;

procedure TOpenGLControl.GLRelease;
begin
  wglMakeCurrent(FDC, 0);
  wglDeleteContext(FRC);
  ReleaseDC(Handle, FDC);
end;

procedure TOpenGLControl.Paint;
begin
  inherited;
  if Assigned(FOnPaint) then
  begin
    FOnPaint(Self);
  end;
end;

end.

要进行测试，请创建一个新应用程序并添加一个 TPanel到表单，同时创建表单 OnCreate和 OnDestroy事件处理程序然后使用以下内容:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, OpenGLControl;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure OpenGLControlPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  FOpenGLControl: TOpenGLControl;

implementation

uses
  OpenGL;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FOpenGLControl := TOpenGLControl.Create(nil);
  FOpenGLControl.Parent := Panel1;
  FOpenGLControl.Align := alClient;
  FOpenGLControl.Visible := True;
  FOpenGLControl.OnPaint := OpenGLControlPaint;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FOpenGLControl.Free;
end;

procedure TForm1.OpenGLControlPaint(Sender: TObject);
begin
  glViewPort(0, 0, FOpenGLControl.Width, FOpenGLControl.Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  glBegin(GL_TRIANGLES);
    glColor3f(0.60, 0.10, 0.35);
    glVertex3f( 0.0, 1.0, 0.0);
    glVertex3f(-1.0,-1.0, 0.0);
    glVertex3f( 1.0,-1.0, 0.0);
  glEnd;

  SwapBuffers(wglGetCurrentDC);
end;

end.

有趣的是设置 FOpenGLControl 的父级表单似乎按预期工作，例如:

procedure TForm1.FormCreate(Sender: TObject);
begin
  FOpenGLControl := TOpenGLControl.Create(nil);
  FOpenGLControl.Parent := Form1;
  FOpenGLControl.Align := alClient;
  FOpenGLControl.Visible := True;
  FOpenGLControl.OnPaint := OpenGLControlPaint;
end;

重要的是要知道我对 OpenGL 的了解有限，而且其中大部分对我来说都是新的，我不确定这是否与设置我认为我已经完成的窗口的视口(viewport)有关，但问题可能出在其他地方或者我做错了什么。

所以我的问题是，当父窗口调整大小时，如何在控件内正确渲染 OpenGL 而不会拉伸(stretch)/扭曲？

谢谢你。

更新 1

procedure TForm1.FormResize(Sender: TObject);
var
  Aspect: Single;
begin
  glViewPort(0, 0, FOpenGLControl.Width, FOpenGLControl.Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  Aspect := Real(FOpenGLControl.Width) / Real(FOpenGLControl.Height);
  glOrtho(-Aspect, Aspect, -1.0, 1.0, -1.0, 1.0);
end;

procedure TForm1.OpenGLControlPaint(Sender: TObject);
begin
  glBegin(GL_TRIANGLES);
    glColor3f(0.60, 0.10, 0.35);
    glVertex3f(0.0, 1.0, 0.0);
    glVertex3f(-1.0,-1.0, 0.0);
    glVertex3f( 1.0,-1.0, 0.0);
  glEnd;

  SwapBuffers(wglGetCurrentDC);
end;

上述方法有效，但仅当父对象与客户端对齐时，在此示例中，当 Panel1与客户保持一致。当面板未对齐时，它会在调整窗口大小时扭曲。

Answer 1

如果视口(viewport)是矩形的，则必须通过将场景的坐标映射到视口(viewport)来考虑这一点。

您必须使用正交投影矩阵。投影矩阵将所有顶点数据从眼睛坐标转换为剪辑坐标。然后，这些剪辑坐标也通过除以剪辑坐标的 w 分量转换为标准化设备坐标 (NDC)。标准化的设备坐标在 (-1, -1, -1) 到 (1, 1, 1) 范围内。

如果使用正交投影矩阵，则眼睛空间坐标会线性映射到 NDC。 glOrtho 可以设置正交矩阵.

要解决您的问题，您必须计算 Aspect视口(viewport)的，它是一个浮点值，表示视口(viewport)的宽度和高度之间的关系，您必须初始化正交投影矩阵。

根据 TCustomControl 的文档, 是 Width和 Height纵横控件大小以像素为单位。但这不等于控件客户区的大小。使用ClientWidth和 ClientHeight相反，它给出了控件客户区的宽度和高度(以像素为单位)。

procedure TForm1.FormResize(Sender: TObject);
var
    Aspect: Single;
begin
    glViewPort(0, 0, FOpenGLControl.ClientWidth, FOpenGLControl.ClientHeight);
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity();
    Aspect := Real(FOpenGLControl.ClientWidth) / Real(FOpenGLControl.ClientHeight);
    glOrtho(-Aspect, Aspect, -1.0, 1.0, -1.0, 1.0);
end;