2

I am trying to render text in OpenGL, this is how I do it:

  • read pixels to bitmap using glReadPixels and SetDIBits;
  • draw text on bitmap using canvas;
  • draw pixels to main frame buffer using GetDIBits and glDrawPixels.

This is what I get when I render Sample text (81x21).

The bitmap.

This is what I get when I render Sample text. (84x21) (with dot at the end).

It works. It always works when resulting text's width is power of two! Strange...
This is the code.

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;

I double checked the code with glGetError - no errors. I've seen many reports of odd behaviour with SetDIBits and its derivatives. Some claim that the weirdness has to do with Delphi memory management, though I have my doubts. Any ideas what I can try next?

Edit: it works if I use alpha.

4

1 回答 1

3

您需要考虑对齐。默认情况下，GL 要求每个图像行对齐 4 字节。Asy 每个像素使用 3 个字节，可以是任何东西，具体取决于宽度。查看glPixelStore()以更改 alignmet。对于您的用例，应该将GL_PACK_ALIGNMENT（用于从 GL 读取像素）和GL_UNPACK_ALIGNMENT（用于将像素发送到 GL）设置为 1 特别有用。

于 2013-07-18T21:22:10.453 回答