delphi - OpenGL 中的奇怪行为

标签 delphi opengl windows-7 delphi-7

我正在尝试在 OpenGL 中渲染文本,这就是我的做法:

  • 使用 glReadPixelsSetDIBits 将像素读取到位图;
  • 使用 Canvas 在位图上绘制文本;
  • 使用 GetDIBitsglDrawPixels 将像素绘制到主帧缓冲区。

这是我渲染示例文本 (81x21) 时得到的结果。

"Sample text"

位图。

"Sample text" bitmap

这是我渲染示例文本时得到的结果。 (84x21)(末尾带有点)。

"Sample text."

"Sample text." bitmap

它有效。当结果文本的宽度是 2 的幂时,它总是有效!奇怪的...
这是代码。

procedure TMainForm.RenderBtnClick(Sender: TObject);
var
  DC, RC: HDC;
  BMP: TBitmap;
  Pixels: Pointer;
  X, Y, W, H: Integer;
  Header: PBitmapInfo;
  Result, Error: Integer;
  Str: String;
begin
  // Initialize OpenGL
  if InitOpenGL = False then
    Application.Terminate;
  DC := GetDC(Handle);
  RC := CreateRenderingContext(DC,
                              [OpDoubleBuffered],
                              32,
                              24,
                              0,
                              0,
                              0,
                              0);
  ActivateRenderingContext(DC, RC);
  Caption :=
    'OpenGL version: ' + glGetString(GL_VERSION) + ' | ' +
    'vendor: '         + glGetString(GL_VENDOR) + ' | ' +
    'renderer: '       + glGetString(GL_RENDERER);

  // Setup OpenGL 
  glClearColor(0.27, 0.4, 0.7, 0.0); // Light blue
  glViewport(0, 0, ClientWidth, ClientHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glOrtho(0, ClientWidth, 0, ClientHeight, 0, 1);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  glClear(GL_COLOR_BUFFER_BIT);

  BMP := TBitmap.Create;
  BMP.PixelFormat := pf24bit;
  BMP.Canvas.Font.Name := 'Segoe UI';
  BMP.Canvas.Font.Size := 12;
  BMP.Canvas.Font.Color := clWhite;
  BMP.Canvas.Brush.Style := bsClear;
  Str := Edit.Text;
  W := BMP.Canvas.TextWidth(Str);
  H := BMP.Canvas.TextHeight(Str);
  X := (ClientWidth - W) div 2;
  Y := (ClientHeight - H) div 2;
  BMP.Width := W;
  BMP.Height := H;

  GetMem(Pixels, W * H * 3);
  GetMem(Header, SizeOf(TBitmapInfoHeader));
  with Header^.bmiHeader do
  begin
    biSize := SizeOf(TBitmapInfoHeader);
    biWidth := W;
    biHeight := H;
    biCompression := BI_RGB;
    biPlanes := 1;
    biBitCount := 24;
    biSizeImage := W * H * 3;
  end;

  glReadPixels(X, Y, W, H, GL_BGR, GL_UNSIGNED_BYTE, Pixels);
  Result := SetDIBits(BMP.Canvas.Handle, BMP.Handle, 0, H, Pixels,
    TBitmapInfo(Header^), DIB_RGB_COLORS);
  if Result = 0 then
  begin
    Error := GetLastError;
    raise Exception.Create('"SetDIBits" error ' + IntToStr(Error) + ': ' + SysErrorMessage(Error));
  end;

  BMP.Canvas.TextOut(0, 0, Str);
  BMP.SaveToFile('C:/TextOut.bmp'); // for debugging purposes of course

  Result := GetDIBits(BMP.Canvas.Handle, BMP.Handle, 0, H, Pixels, TBitmapInfo(Header^), DIB_RGB_COLORS);
  if Result = 0 then
  begin
    Error := GetLastError;
    raise Exception.Create('"GetDIBits" error ' + IntToStr(Error) + ': ' + SysErrorMessage(Error));
  end;

  glRasterPos2i(X, Y);
  glDrawPixels(W, H, GL_BGR, GL_UNSIGNED_BYTE, Pixels);
  SwapBuffers(DC);

  // Free memory
  DeactivateRenderingContext;
  wglDeleteContext(RC);
  ReleaseDC(Handle, DC);
  FreeMem(Header);
  FreeMem(Pixels);
  BMP.Free;
end;

我用 glGetError 仔细检查了代码 - 没有错误。我见过许多关于 SetDIBits 及其衍生物的奇怪行为的报告。 有人声称这种奇怪现象与 Delphi 内存管理有关, 虽然我有疑问。我接下来可以尝试什么想法吗?

编辑:如果我使用 alpha,它就可以工作。

最佳答案

您需要考虑对齐情况。默认情况下,GL 期望每个图像行进行 4 字节对齐。如果每个像素使用 3 个字节,则可以是任何值,具体取决于宽度。看看glPixelStore()更改对齐方式。对于您的用例,特别有用的是将 GL_PACK_ALIGNMENT (用于从 GL 读取像素)和 GL_UNPACK_ALIGNMENT (用于将像素发送到 GL)设置为 1。

关于delphi - OpenGL 中的奇怪行为,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/17733965/

相关文章:

windows-7 - Win7 上的 VC6、SourceSafe diff 查看器不会在左 Pane 上绘制文本(最大化时)

delphi - 如何制作像 IDE 那样的可停靠表单,而不会使可停靠表单的卡住速度非常缓慢?

delphi - 让 Woll2Woll 与 Delphi 7 dbExpress 一起工作的方法?

c++ - 如何确保粒子始终在中心对齐

c++ - 从产品 key 确定 vista/windows 7 操作系统版本的算法

ruby - 使用 therubyracer 在 Windows 机器上安装 ruby​​ gem less-rails

Delphi:如何使用 $OVERFLOWCHECKS OFF 禁用溢出检查?

c++ - 如何使用 Visual C++ 中的 Delphi 寄存器调用约定调用函数?

c++ - 有没有办法访问 OpenGL 的深度缓冲区?

OpenGL - 同一对象的不同表面上的不同纹理