Delphi 和OpenGL -简单示例

s4n0splo 于 2023-03-02 发布在其他

关注(0)|答案(1)|浏览(184)

我正在尝试用Delphi和OpenGL创建一些基本的应用程序。我需要在屏幕上绘制一些2D图像。
下面是我的代码：

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    GLContext : HGLRC;
    glDC: HDC;
    errorCode: GLenum;
    openGLReady: Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  pfd: TPixelFormatDescriptor;
  FormatIndex: Integer;
begin
  FillChar(pfd,SizeOf(pfd),0);
  with pfd do
  begin
    nSize := SizeOf(pfd);
    nVersion := 1; {The current version of the desccriptor is 1}
    dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 24; {support 24-bit color}
    cDepthBits := 32; {depth of z-axis}
    iLayerType := PFD_MAIN_PLANE;
  end;
  glDC := getDC(handle);
  FormatIndex := ChoosePixelFormat(glDC,@pfd);
  SetPixelFormat(glDC,FormatIndex,@pfd);
  GLContext := wglCreateContext(glDC);
  wglMakeCurrent(glDC,GLContext);
  OpenGLReady := true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  wglMakeCurrent(Canvas.Handle,0);
  wglDeleteContext(GLContext);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  if not openGLReady then
    exit;
  {background}
  glClearColor(0.1,0.0,0.1,0.0);
  glClear(GL_COLOR_BUFFER_BIT);
  glLoadIdentity; // Reset The View
  glTranslatef(0.0, 0, 0.0);
  glRotateF (360, 0.0, 0.0, 1.0);
  glBegin( GL_POLYGON ); // start drawing a polygon
    glColor3f( 1.0, 0.0, 0.0);
    glVertex3f( 0.0, 0.5, 0.0 ); // Top
    glColor3f(0.0, 1.0, 0.0);
    glVertex3f( 0.5, -0.5, 0.0 ); // Bottom Right
    glColor3f(0.0, 0.0, 1.0);
    glVertex3f( -0.5, -0.5, 0.0 ); // Bottom Left
  glEnd;
  glFlush;
  {error checking}
  errorCode:=glGetError;
   if errorCode<>GL_NO_ERROR then
      raise Exception.Create('Error in Paint'#13+gluErrorString(errorCode));
  SwapBuffers(wglGetCurrentDC);
  glFlush();
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  if not openGLReady then
  exit;
  glViewPort(0,0,ClientWidth,ClientHeight);
  glOrtho(-1.0,1.0,-1.0,1.0,-1.0,1.0);
  errorCode := glGetError;
  if errorCode<>GL_NO_ERROR then
  raise Exception.Create('FormResize:'+gluErrorString(errorCode));
end;

procedure GLInit;
begin
  // set viewing projection
  glMatrixMode(GL_PROJECTION);
  glFrustum(-0.1, 0.1, -0.1, 0.1, 0.3, 15.0);
  // position viewer
  glMatrixMode(GL_MODELVIEW);
  glEnable(GL_DEPTH_TEST);
end;

end.

一切都正常，没有错误，但最后我没有得到一个深绿色的表格，表格保持不变（灰色）。
这有什么不对吗？
我已经启动应用程序从IDE和作为独立的应用程序。我正在使用Delphi 10.4和Windows 10。我已经检查和opengl32.dll是在System32文件夹。

opengl

来源：https://stackoverflow.com/questions/75602621/delphi-and-opengl-simple-example

1条答案

按热度按时间

eqzww0vc1#

您的代码中有几个问题。首先，您从未调用GLInit过程，因此从未设置投影矩阵。此外，GLInit使用glFrustum，而窗体大小调整处理程序使用glOrtho。您需要哪个？
我找到了一个非常老的OpenGL示例应用程序，我做了几十年前，你可能会学习（在这里稍微现代化的形式）：

unit mainWin;

interface

uses
  OpenGL, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Math;

type

  TBall = record
    x, phi: Double;
  end;

  TmainFrm = class(TForm)
    Timer1: TTimer; // 25 ms
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure WMEraseBkGnd(var Message:TMessage); message WM_ERASEBKGND;
  private
    Angle: Double;
    Balls: array[0..100] of TBall;
    BallIndex: Integer;
    procedure InitGL;
  end;

var
  mainFrm: TmainFrm;

implementation

{$R *.dfm}

procedure TmainFrm.InitGL;
const
  pfd: TPixelFormatDescriptor = (
    nSize: SizeOf(TPixelFormatDescriptor);
    nVersion: 1;
    dwFlags: PFD_SUPPORT_OPENGL or PFD_DRAW_TO_WINDOW 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: 24;
    cStencilBits: 0;
    cAuxBuffers: 0;
    iLayerType: PFD_MAIN_PLANE;
    bReserved: 0;
    dwLayerMask: 0;
    dwVisibleMask: 0;
    dwDamageMask: 0;
  );

begin
  var DC := GetDC(Handle);
  var PixelFormat := ChoosePixelFormat(DC, @pfd);
  if PixelFormat = 0 then
    RaiseLastOSError;
  if not SetPixelFormat(DC, PixelFormat, @pfd) then
    RaiseLastOSError;
  var RC := wglCreateContext(DC);
  if RC = 0 then
    RaiseLastOSError;
  wglMakeCurrent(DC, RC);
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_LINE_SMOOTH);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glHint(GL_LINE_SMOOTH_HINT, GL_NICEST);
  glPointSize(10);
  glEnable(GL_POINT_SMOOTH);
  FormResize(Self);
end;

procedure TmainFrm.FormPaint(Sender: TObject);
const
  p1: TGLArrayf3 = (-5, -5, -1);
  p2: TGLArrayf3 = (5, -5, -1);
  p3: TGLArrayf3 = (0, 5, -1);
begin

  if Tag = 0 then
  begin
    InitGL;
    Tag := 1;
  end;

  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  glColor3ub(255, 255, 255);
  glRotate(Angle, 0, 0, 1);
  glBegin(GL_TRIANGLES);
  glVertex3fv(@p1); glVertex3fv(@p2); glVertex3fv(@p3);
  glEnd;
  glRotate(-Angle, 0, 0, 1);

  glColor3ub(255, 0, 0);

  for var i := Low(Balls) to High(Balls) do
  begin
    if (Balls[i].x = 0) or (Balls[i].x > 100) then
      Continue;
    glRotate(Balls[i].phi, 0, 0, 1);
    glBegin(GL_POINTS);
    glVertex3f(0, Balls[i].x, -1);
    glEnd;
    glRotate(-Balls[i].phi, 0, 0, 1);
  end;

  SwapBuffers(wglGetCurrentDC);

end;

procedure TmainFrm.FormResize(Sender: TObject);
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  const AR = ClientWidth / Max(ClientHeight, 1);
  glLoadIdentity;
  glOrtho(-15*AR, 15*AR, -15, 15, 0.5, 25.0);
  glMatrixMode(GL_MODELVIEW);
end;

procedure TmainFrm.Timer1Timer(Sender: TObject);
begin

  for var i := Low(Balls) to High(Balls) do
    if Balls[i].x <> 0 then
      Balls[i].x := Balls[i].x + 1;

  if csLButtonDown in ControlState then // Add new ball
  begin
    Balls[BallIndex].x := 5;
    Balls[BallIndex].phi := Angle;
    BallIndex := Succ(BallIndex) mod Length(Balls);
  end;

  Invalidate;

end;

procedure TmainFrm.WMEraseBkGnd(var Message: TMessage);
begin
  Message.Result := 1;
end;

procedure TmainFrm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Angle := ArcTan2(-Y + ClientHeight div 2, X - ClientWidth div 2) * 180 / Pi + 270;
end;

end.

但是，请注意形容词 old。现在，您根本不应该使用固定管道API。

赞(0）回复(0）举报 2023-03-02

我来回答

Delphi 和OpenGL -简单示例

1条答案

相关问题

热门标签

最新问答