Как реализовать, используя OpenGL, вывод текста, используя шрифт?
Это необходимо для подписи осей координат, вывода шкалы(для МКЭ) и т.п.

Модератор: Модераторы
      Base := glGenLists(256);  // Выделим место для 256 символов
      font := CreateFont(  height,0,0,0,b,i,0,0, ANSI_CHARSET,OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,
                           ANTIALIASED_QUALITY, FF_DONTCARE or DEFAULT_PITCH,PChar(name_));
      old := SelectObject(Screen.DC, font);        // Выбрать шрифт, созданный нами
      wglUseFontBitmaps(Screen.DC, 0, 255, Base); // Построить 96 символов начиная с пробела
      SelectObject(Screen.DC, old);  
      DeleteObject(font);       glPushMatrix;
       glLoadIdentity;
       glRasterPos2F(x,y)
       glPushAttrib(GL_LIST_BIT);
       glListBase(Base);          // Задать базу символа
       glCallLists(length(str), GL_UNSIGNED_BYTE, @str[1]); // Текст списками отображения
       glPopAttrib;
       glPopMatrix;
AlexPavel писал(а):Если возможно, представьте код, реализующий вывод текста с использованием системного шрифта. Применение текстуры не подходит, т.к. выводимая информация меняется.
 glTexSubImage2D
 glTexSubImage2D
unit f_main;
{$mode objfpc}{$H+}
interface
uses
  ... OpenGLContext, GL, LazUTF8;
type
  { TMainForm }
  TMainForm = class(TForm)
    ...
    TImg: TImage;
    ViewPanel: TOpenGLControl;
    ...
  private
    ...
    function VPGLX(X: integer): double;
    function VPGLY(Y: integer): double;
    procedure GLPrepareFont;
    procedure MakeCharTexture(C: byte; var tmem: pbyte);
    procedure GLWriteText(Txt: string; X,Y: integer);
    ...
  end;
var
  MainForm: TMainForm;
  FontHeight, CharWidth: word;
  TTID: array [0..255] of GLuint;
  TTData: array [0..255] of ^Byte;
  TTW: array [0..255] of byte;
implementation
...
function TMainForm.VPGLX(X: integer): double;
begin //Пересчёт координаты X
 VPGLX:=(X*2 / ViewPanel.ClientWidth) - 1;
end;
function TMainForm.VPGLY(Y: integer): double;
begin //Пересчёт координаты Y
 VPGLY:=1 - (Y*2 / ViewPanel.ClientHeight);
end;
procedure TMainForm.MakeCharTexture(C: byte; var tmem: pbyte);
var //Создание текстуры для отдельного символа
 x: integer;
 b: byte;
 s: string;
begin
 s:=WinCPToUTF8(chr(C));
 //Запоминаем реальную ширину символа
 TTW[c]:=TImg.Canvas.TextWidth(s);
 if (TTW[c] > CharWidth) then TTW[c]:=CharWidth;
 //Вывод символа в TImage
 TImg.Picture.Bitmap.Canvas.Clear;
 TImg.Picture.Bitmap.Canvas.Brush.Color:=clWhite;
 TImg.Picture.Bitmap.Canvas.FillRect(Rect(0,0,CharWidth,FontHeight));
 TImg.Picture.Bitmap.Canvas.Font.Color:=clBlack; //Цвет шрифта
 TImg.Picture.Bitmap.Canvas.TextOut(0,0,s);
 Application.ProcessMessages;
 //Копируем изображение символа в текстуру
 GetMem(tmem,CharWidth*FontHeight*4);
 tmem:=TImg.Picture.Bitmap.RawImage.Data;
 for x:=0 to (CharWidth*FontHeight-1) do
  begin
   {$IFDEF WINDOWS}
   //Расставляем цвета на свои места в Windows
   b:=tmem[x*4];
   tmem[x*4]:=tmem[x*4+2];
   tmem[x*4+2]:=b;
   {$ENDIF}
   //Прописываем альфу на основе красного цвета
   if (tmem[x*4]=255) then tmem[x*4+3]:=0 else tmem[x*4+3]:=255;
  end;
end;
procedure TMainForm.GLPrepareFont;
var //Подготовка шрифта. Вызывать один раз до первого вывода текста, например при FormShow
 b: integer;
begin
 //Задаём размер шрифта
 FontHeight:=16;
 CharWidth:=16;
 TImg.Canvas.Font.Height:=FontHeight;
 TImg.Picture.Bitmap.PixelFormat:=pf32bit;
 TImg.Picture.Bitmap.Height:=FontHeight;
 TImg.Picture.Bitmap.Width:=CharWidth;
 ViewPanel.Invalidate;
 //Подготовка текстур
 glEnable(GL_TEXTURE_2D);
 glGenTextures(256, @TTID[0]);
 for b:=32 to 255 do
  begin //Цикл создания текстур
   {if (b mod 5 = 0) then
    StatusBar1.SimpleText:='Подготовка шрифта OpenGL... '+inttostr(b*100 div 255)+' %'; }
   MakeCharTexture(b,TTData[b]);
   glBindTexture(GL_TEXTURE_2D, TTID[b]);
   glTexImage2D(GL_TEXTURE_2D, 0, 4, CharWidth, FontHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TTData[b]);
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
   glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
  end;
end;
procedure TMainForm.GLWriteText(Txt: string; X,Y: integer);
var //Вывод строки. Координаты задаём целыми числами, как при работе с обычным Canvas
 n,i: integer;
 c: byte;
 s: ansistring;
begin
 i:=X;
 glColor3b(127,127,127);
 s:=UTF8ToWinCP(Txt);
 glEnable(GL_BLEND);
 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 for n:=1 to length(s) do
  begin
   c:=ord(s[n]);
   if (c<32) then continue;
   glEnable(GL_TEXTURE_2D);
   glBindTexture(GL_TEXTURE_2D, TTID[c]);
   glBegin(GL_QUADS);
   glTexCoord2f(0, 0);
   glVertex2d(VPGLX(i),VPGLY(Y));
   glTexCoord2f(0, 1);
   glVertex2d(VPGLX(i),VPGLY(Y+FontHeight));
   glTexCoord2f(TTW[c]/CharWidth, 1);
   glVertex2d(VPGLX(i+TTW[c]),VPGLY(Y+FontHeight));
   glTexCoord2f(TTW[c]/CharWidth, 0);
   glVertex2d(VPGLX(i+TTW[c]),VPGLY(Y));
   i:=i+TTW[c];
   glEnd;
   glDisable(GL_TEXTURE_2D);
  end;
 glDisable(GL_BLEND);
end;
...
//Пример оспользования
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
...
glBegin(...); ... glEnd;
GLWriteText('Text Текст',ViewPanel.ClientWidth div 2, ViewPanel.ClientHeight div 2);
...
ViewPanel.SwapBuffers;
...
end.
 OpenGl Рисуем в Фоне, возможно ли?
  OpenGl Рисуем в Фоне, возможно ли?Сейчас этот форум просматривают: mike и гости: 1