私は OpenGL でテキストをレンダリングしようとしています。これが私のやり方です:
glReadPixelsandを使用してピクセルをビットマップに読み取りSetDIBitsます。- キャンバスを使用してビットマップにテキストを描画します。
GetDIBitsとを使用してピクセルをメイン フレーム バッファに描画しglDrawPixelsます。
これは、レンダリングすると得られるものですSample text(81x21)。
ビットマップ。
Sample text.これは、 (84x21) (最後にドットを付けて)レンダリングしたときに得られるものです。
できます。結果のテキストの幅が 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 のメモリ管理に関係していると主張する人もいますが、私には疑問があります。次に試すことができるアイデアはありますか？
編集：アルファを使用すると機能します。