Программа на Delphi c OpenGl

@crazypiggy · Регистрация: 05.04.2010

Author24 — интернет-сервис помощи студентам

Добрый день. У меня следующая проблема. На OpenGl в Delphi пишу программу которая должна нарисовать на экране заданное количество строк и три столбца. и в каждой ячейке вывести какой либо текст. Сижу потихоньку изучаю Краснова. Вероде удалось линиями разрисовать экран. Но как вывести в эти ячейки текст не могу понять. Пытаюсь написать по примерам Краснова, но что то не выходит... Туплю

Помогите пожалуйста с этим разобраться
Привожу пример где я пытаюсь все это сделать.

Delphi

unit MainUnit;
 
interface
 
uses
  Windows, Messages, Forms, Dialogs, Classes, Controls, ExtCtrls, StdCtrls,
  OpenGL;
 
  const colrow=4;
 
type
  TfrmGL = class(TForm)
    Panel1: TPanel;
    procedure FormPaint(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    dc : HDC;
    hrc: HGLRC;
    procedure drawLine(x1,y1,x2,y2,r,g,b : GLfloat);
  end;
 
var
  frmGL: TfrmGL;
 
implementation
 
{$R *.dfm}
 
{ TTfrmGL }
const
  GLF_START_LIST = 1000;
 
{=======================================================================
Рисование окна}
procedure TfrmGL.FormPaint(Sender: TObject);
var
 ps : TPaintStruct;
 i:integer;
begin
 BeginPaint (Panel1.Handle, ps);        
 wglMakeCurrent(dc, hrc);
 glClearColor (0.0, 0.0, 0.0, 1.0);
 glClear (GL_COLOR_BUFFER_BIT);
 for i:=1 to colrow do begin
 drawLine(-0.98, (-1+i*2/(colrow+1)) ,0.98, (-1+i*2/(colrow+1)) , 0,0,1);
 end;
 drawLine(-0.5,-0.98,-0.5,0.98,0,0,1);
 drawLine(0.25,-0.98,0.25,0.98,0,0,1);
 
 wglMakeCurrent(0, 0);
 EndPaint (Panel1.Handle, ps);
end;
 
{=======================================================================
Формат пикселя}
procedure SetDCPixelFormat (hdc : HDC);
var
 pfd : TPIXELFORMATDESCRIPTOR;
 nPixelFormat : Integer;
begin
 FillChar(pfd, SizeOf(pfd), 0);
 nPixelFormat := ChoosePixelFormat (hdc, @pfd);
 SetPixelFormat (hdc, nPixelFormat, @pfd);
end;
 
{=======================================================================
Начало работы приложения}
procedure TfrmGL.FormCreate(Sender: TObject);
begin
 dc := GetDC (Panel1.Handle);
 SetDCPixelFormat(dc);
 hrc := wglCreateContext(dc);
end;
 
{=======================================================================
Конец работы приложения}
procedure TfrmGL.FormDestroy(Sender: TObject);
begin
 wglDeleteContext(hrc);
end;
 
procedure TfrmGL.drawLine(x1, y1, x2, y2, r, g, b: GLfloat);
begin
glLineWidth (5.0);
glColor3f (r, g, b);
glBegin(GL_LINES);
  glVertex2f (x1,y1);
  glVertex2f (x2,y2);
glEnd;
end;
 
end.

@snake32 · 05.04.2010, 21:48

Что-то я кода не вижу для шрифта. Где он? Делфи какая используется? 7 или выше? Если выше, посмотрите как определён тип PChar. Он может определён как Unicode то есть PChar = PWideChar; Тогда измените в своей программе все PChar'ы на PAnsiChar'ы.

@crazypiggy · 06.04.2010, 10:37 **[ТС]**

Сообщение от snake32

Что-то я кода не вижу для шрифта. Где он? Делфи какая используется? 7 или выше? Если выше, посмотрите как определён тип PChar. Он может определён как Unicode то есть PChar = PWideChar; Тогда измените в своей программе все PChar'ы на PAnsiChar'ы.

Использую Delphi 7. В этом примере я разграфил экран на ячейки. А вот как туда запихнуть трехмерный текст и чтобы он вращался я не знаю. Все примеры рассмотрел, но никак не возьму втолк как это сделать.

@snake32 · 06.04.2010, 16:11

Вконце FormCreate добавляете инициализацию диплейлистов со шрифтами.
Уничтожение их(дисплейлистов) вначале деструктора FormDestroy
Собственно рисование вставляете в FormPaint : например строка 51

@crazypiggy · 06.04.2010, 17:52 **[ТС]**

Сообщение от snake32

Вконце FormCreate добавляете инициализацию диплейлистов со шрифтами.
Уничтожение их(дисплейлистов) вначале деструктора FormDestroy
Собственно рисование вставляете в FormPaint : например строка 51

Delphi

procedure TfrmGL.FormCreate(Sender: TObject);
begin
 dc := GetDC (Panel1.Handle);
 SetDCPixelFormat(dc);
 hrc := wglCreateContext(dc);
 wglUseFontOutlines (Panel1.Handle, 0, 255, GLF_START_LIST, 50, 0.15,
                      WGL_FONT_POLYGONS, nil);
end;

Delphi

procedure OutText (Litera : PChar);
begin
  glListBase(GLF_START_LIST);
  glCallLists(Length (Litera), GL_UNSIGNED_BYTE, Litera);
end;
 
procedure TfrmGL.FormPaint(Sender: TObject);
var
 ps : TPaintStruct;
 i:integer;
begin
 BeginPaint (Panel1.Handle, ps);        
 wglMakeCurrent(dc, hrc);
 glClearColor (0.0, 0.0, 0.0, 1.0);
 glClear (GL_COLOR_BUFFER_BIT);
 for i:=1 to colrow do begin
 drawLine(-0.98, (-1+i*2/(colrow+1)) ,0.98, (-1+i*2/(colrow+1)) , 0,0,1);
 end;
 drawLine(-0.5,-0.98,-0.5,0.98,0,0,1);
 drawLine(0.25,-0.98,0.25,0.98,0,0,1);
 OutText('124');
 wglMakeCurrent(0, 0);
 EndPaint (Panel1.Handle, ps);
end;
 
procedure TfrmGL.FormDestroy(Sender: TObject);
begin
  glDeleteLists (GLF_START_LIST, 256);
  wglMakeCurrent(0, 0);
  wglDeleteContext(hrc);
  ReleaseDC(Panel1.Handle, DC);
  DeleteDC(DC);
end;

Не выводит ничего кроме линий. Текста нет. Может я не так делаю?

@snake32 · 06.04.2010, 20:59

wglMakeCurrent(dc, hrc);
перед wglUseFontOutlines поставте
Ща у себя проверю...

Добавлено через 42 минуты
Короче проще оказалось переделать проект Kрасного:

Delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OpenGL, ExtCtrls;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    dc : HDC;
    hrc: HGLRC;
    procedure SetDCPixelFormat;
    procedure drawLine(x1,y1,x2,y2,r,g,b : GLfloat);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
const GLF_START_LIST = 1000;
const colrow=4;
 
 
{=======================================================================
Вывод текста}
procedure OutText (Litera : shortstring);
begin
  glListBase(GLF_START_LIST);
  glCallLists( Length( Litera ), GL_UNSIGNED_BYTE, @Litera[1] );
end;
 
{=======================================================================
Рисование картинки}
procedure TForm1.FormPaint(Sender: TObject);
var i:integer;
begin
 // очистка буфера цвета и буфера глубины
 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 
 for i:=1 to colrow do begin
 drawLine(-0.98, (-1+i*2/(colrow+1)) ,0.98, (-1+i*2/(colrow+1)) , 0,0,1);
 end;
 drawLine(-0.5,-0.98,-0.5,0.98,0,0,1);
 drawLine(0.25,-0.98,0.25,0.98,0,0,1);
 
 glRasterPos2f (0,0);
 OutText ('0123');
 
 SwapBuffers(DC);
end;
 
{=======================================================================
Установка формата пикселей}
procedure TForm1.SetDCPixelFormat;
var
  nPixelFormat: Integer;
  pfd: TPixelFormatDescriptor;
 
begin
  FillChar(pfd, SizeOf(pfd), 0);
 
  with pfd do begin
    nSize     := sizeof(pfd);
    nVersion  := 1;
    dwFlags   := PFD_DRAW_TO_WINDOW or
                 PFD_SUPPORT_OPENGL or
                 PFD_DOUBLEBUFFER;
    iPixelType:= PFD_TYPE_RGBA;
    cColorBits:= 24;
    iLayerType:= PFD_MAIN_PLANE;
  end;
 
  nPixelFormat := ChoosePixelFormat(DC, @pfd);
  SetPixelFormat(DC, nPixelFormat, @pfd);
end;
 
{=======================================================================
Создание окна}
procedure TForm1.FormCreate(Sender: TObject);
begin
  DC := GetDC(Handle);
  SetDCPixelFormat;
  hrc := wglCreateContext(DC);
  wglMakeCurrent(DC, hrc);
  glClearColor (0.0, 0.0, 0.0, 1.0);
  wglUseFontBitmaps (Canvas.Handle, 0, 255, GLF_START_LIST);
 
 // glEnable(GL_DEPTH_TEST);// разрешаем тест глубины
 // glEnable(GL_LIGHTING); // разрешаем работу с освещенностью
 // glEnable(GL_LIGHT0);   // включаем источник света 0
end;
 
{=======================================================================
Изменение размеров окна}
procedure TForm1.FormResize(Sender: TObject);
begin
  glViewport(0, 0, ClientWidth, ClientHeight);
  InvalidateRect(Handle, nil, False);
end;
 
{=======================================================================
Конец работы приложения}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  glDeleteLists (GLF_START_LIST, 256);
  wglMakeCurrent(0, 0);
  wglDeleteContext(hrc);
  ReleaseDC(Handle, DC);
  DeleteDC (DC);
end;
 
procedure TForm1.drawLine(x1, y1, x2, y2, r, g, b: GLfloat);
begin
glLineWidth (5.0);
glColor3f (r, g, b);
glBegin(GL_LINES);
  glVertex2f (x1,y1);
  glVertex2f (x2,y2);
glEnd;
end;
 
end.

Добавлено через 1 минуту
Только у меня всё равно пока отказывается выводить русский шрифт....

Добавлено через 55 секунд
на 2010 делфе

@crazypiggy · 07.04.2010, 12:45 **[ТС]**

Сообщение от snake32

Только у меня всё равно пока отказывается выводить русский шрифт....

Спасибо за пример. У меня на 7 нормально выводит русский текст. Вот только небольшая загвоздка. Не могу сделать его трехмерным. Я так понял что

Delphi

1	glRasterPos2f (0,0);

это для двухмерного вывода, а нет ли возможности вывести трехмерный текст?

@snake32 · 07.04.2010, 17:25

crazypiggy, для трёхмерного вывода текста надо:
1.Установить формат пикселя с z буфером
2.Включить его
3.В glClear - очищать его
4.А так же задать в FormResize матрицу проекций
5.Вместо wglUseFontBitmaps использовать wglUseFontOutlines

У Краснова это всё есть

@crazypiggy · 08.04.2010, 12:23 **[ТС]**

Спасибо. Вроде разобрался.

@snake32 3408 / 1595 / 236 Регистрация: 26.02.2009 Сообщений: 7,839 Записей в блоге: 5
	05.04.2010, 21:48	2
	Что-то я кода не вижу для шрифта. Где он? Делфи какая используется? 7 или выше? Если выше, посмотрите как определён тип PChar. Он может определён как Unicode то есть PChar = PWideChar; Тогда измените в своей программе все PChar'ы на PAnsiChar'ы. 0

@crazypiggy 0 / 0 / 0 Регистрация: 05.04.2010 Сообщений: 5
	06.04.2010, 10:37 [ТС]	3
	Сообщение от snake32 Что-то я кода не вижу для шрифта. Где он? Делфи какая используется? 7 или выше? Если выше, посмотрите как определён тип PChar. Он может определён как Unicode то есть PChar = PWideChar; Тогда измените в своей программе все PChar'ы на PAnsiChar'ы. Использую Delphi 7. В этом примере я разграфил экран на ячейки. А вот как туда запихнуть трехмерный текст и чтобы он вращался я не знаю. Все примеры рассмотрел, но никак не возьму втолк как это сделать. 0

@snake32 3408 / 1595 / 236 Регистрация: 26.02.2009 Сообщений: 7,839 Записей в блоге: 5
	06.04.2010, 16:11	4
	Вконце FormCreate добавляете инициализацию диплейлистов со шрифтами. Уничтожение их(дисплейлистов) вначале деструктора FormDestroy Собственно рисование вставляете в FormPaint : например строка 51 0

@snake32 3408 / 1595 / 236 Регистрация: 26.02.2009 Сообщений: 7,839 Записей в блоге: 5
	07.04.2010, 17:25	8
	crazypiggy, для трёхмерного вывода текста надо: 1.Установить формат пикселя с z буфером 2.Включить его 3.В glClear - очищать его 4.А так же задать в FormResize матрицу проекций 5.Вместо wglUseFontBitmaps использовать wglUseFontOutlines У Краснова это всё есть 0

@crazypiggy 0 / 0 / 0 Регистрация: 05.04.2010 Сообщений: 5
	08.04.2010, 12:23 [ТС]	9
	Спасибо. Вроде разобрался. 0

Опции темы