Delphi OpenGL调整大小

时间:2017-05-17 14:34:26

标签: delphi opengl

我有一个关于从Delphi使用OpenGL的问题。 我的目的是在一个表单中绘制一个n行和n列的网格。我希望网格中的单元格像这个图像一样正方形:

enter image description here

这是我用来创建这个网格的代码:

unit Main;

interface

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

type
  TfrmMain = class(TForm)
    PopupMenu: TPopupMenu;
    mnuDrawGrid: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure mnuDrawGridClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    glDC: HDC;
    oldW: Integer;
    oldH: Integer;
    glContext: HGLRC;
    errorCode: GLenum;
    openGLReady: Boolean;
    procedure DisegnaLinea(const aX1, aY1, aX2, aY2: Double; aSpessore,
      aOffSet: Integer);
    procedure DisegnaTabellone(const aNumRighe, aNumColonne: SmallInt);
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

{ Gestione form -------------------------------------------------------------- }

// OpenGL initialization
procedure TfrmMain.FormCreate(Sender: TObject);
var
  pfd: TPixelFormatDescriptor;
  formatIndex: Integer;
begin
  FillChar(pfd, SizeOf(pfd), 0);
  with pfd do
  begin
    nSize := SizeOf(pfd);
    nVersion := 1;
    dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 24;
    cDepthBits := 32;
    iLayerType := PFD_MAIN_PLANE;
  end;
  glDC := GetDC(Handle);
  formatIndex := ChoosePixelFormat(glDC, @pfd);
  if formatIndex = 0 then
    raise Exception.Create('Choose pixel format failed ' + IntToStr(GetLastError));
  if not SetPixelFormat(glDC, formatIndex, @pfd) then
    raise Exception.Create('Set pixel forma failed ' + IntToStr(GetLastError));
  glContext := wglCreateContext(glDC);
  if not glContext = 0 then
    raise Exception.Create('Create context failed ' + IntToStr(GetLastError));
  if not wglMakeCurrent(glDC, glContext) then
    raise Exception.Create('Make current failsed ' + IntToStr(GetLastError));

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glOrtho(0.0, ClientWidth, 0.0, ClientHeight, 0.0, 1.0);

  oldW := ClientWidth;
  oldH := ClientHeight;

  openGLReady := True;
end;

// OpenGL destruction
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  wglMakeCurrent(Canvas.Handle, 0);
  wglDeleteContext(glContext);
end;

// Form resize
procedure TfrmMain.FormResize(Sender: TObject);
begin
  if not openGLReady then
    exit;
  glViewport(0, 0, ClientWidth, ClientHeight);
  errorCode := glGetError;
  if errorCode <> GL_NO_ERROR then
    raise Exception.Create('Form resize: ' + gluErrorString(errorCode));
  if (ClientWidth <> oldW) and (ClientHeight <> oldH) then
    DisegnaTabellone(10, 10);
  oldW := ClientWidth;
  oldH := ClientHeight;
end;


{ Gestione menu -------------------------------------------------------------- }

// Menu option grid drawing
procedure TfrmMain.mnuDrawGridClick(Sender: TObject);
begin
  DisegnaTabellone(10, 10);
end;



{ OpenGL --------------------------------------------------------------------- }

// Draw a line at aX1, aY1 to aX2, aY2 coordinates
procedure TfrmMain.DisegnaLinea(const aX1, aY1, aX2, aY2: Double; aSpessore,
  aOffSet: Integer);
begin
  glEnable(GL_LINE_SMOOTH);
  glLineWidth(aSpessore);
  glBegin(GL_LINES);
    glVertex2f(aX1, aY1);
    glVertex2f(aX2, aY2);
  glEnd;
end;

// Grid design
procedure TfrmMain.DisegnaTabellone(const aNumRighe, aNumColonne: SmallInt);
const
  vOffSet = 20;
var
  idx: SmallInt;
  pX: Double;
  pY: Double;
  incX: Double;
  incY: Double;
  hPos: Double;
  hWidth: Double;
  widthArea: Integer;
  heightArea: Integer;
  aspectRatio: Double;
begin
  glClearColor(1.0, 1.0, 1.0, 0.0);
  glClear(GL_COLOR_BUFFER_BIT);
  glColor3f(0.0, 0.0, 0.0);

  widthArea := ClientWidth;
  heightArea := ClientHeight;
  aspectRatio := widthArea / heightArea;

  pY := vOffSet / 2;
  incY := (heightArea - vOffSet) / aNumRighe;

  pX := (widthArea - aNumColonne * incY) / 2;
  hPos := pX;
  hWidth := hPos + aNumColonne * incY;
  incX := incY;

  // Draw vertical lines
  for idx := 0 to aNumColonne do begin
    DisegnaLinea(pX, vOffSet / 2, pX, heightArea - vOffSet / 2, 3, 0);
    pX := pX + incX;
  end;

   // Draw horizontal lines
  for idx := 0 to aNumRighe do begin
    DisegnaLinea(hPos, pY, hWidth, pY, 3, 0);
    pY := pY + incY;
  end;

  glFlush;
end;

end.

我在FormCreate事件中初始化像素格式描述,并且我已经创建了一个由弹出菜单调用的例程来绘制网格。在这个例程中,我进行相同的计算,因为我希望网格单元格像我所说的那样是正方形的。所以我取形式的高度(ClientHeight)并将其划分为我需要的行数:在这种情况下10加上我稍微偏移以便在表格的顶部和底部有一个边距。然后我计算了一个穿孔方格的网格宽度。它运作良好,但问题来自我调整表单大小。 我的意图是根据形状尺寸绘制一个更小或更大的新网格,但这只是我的意图,因为网格确实具有正确的aspet比率并且以一种糟糕的方式绘制,如下所示: picure:

enter image description here

我无法理解代码中的错误在哪里。我是OpenGL,所以有人可以帮助我吗?

性爱

1 个答案:

答案 0 :(得分:2)

  1. 虽然您在调整大小时设置了新的glViewport(),但您仍然使用不再相关的旧正投影矩阵。
  2. 因此,在设置新视口之前,您只需要额外的glOrtho()
  3. OpenGL立即模式(glBegin()glEnd()glVertex()等)近二十年已经过时;你真的不应该在2017年使用它。