Little Helper
Little Helper

Reputation: 2456

Strange behaviour in OpenGL

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

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

"Sample text"

The bitmap.

"Sample text" bitmap

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

"Sample text."

"Sample text." bitmap

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.

Upvotes: 2

Views: 866

Answers (1)

derhass
derhass

Reputation: 45322

You need to take the alignment into account. By default, GL expects a 4 byte alignment for each image row. Asy you use 3 bytes per pixel, can be anything, depending on the width. Have a look at glPixelStore() to change the alignmet. Especially useful should be setting GL_PACK_ALIGNMENT (for reading pixels from the GL) and GL_UNPACK_ALIGNMENT (for sending pixels to the GL) to 1 for your use case.

Upvotes: 3

Related Questions