Как с помощью OpenGL рисовать на TBitmap?

@Jomaxplayer · Регистрация: 11.03.2019

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

Доброго времени суток. Может кому то покажется поставленный ниже вопрос глупым, но я на него нормального ответа не нашел.
Использую Delphi XE, как рисовать с помощью OpenGL на TBitmap? Везде все выводят сразу прямиком на форму, но также заикаются и про tbitmap, но используют только для захвата картинок из bmp. Максимум что я смог добиться это раскрашивание фона bitmap. Также смотрел пару уроков для новичков использование OpenGL, и также просмотрел книгу Краснова, пытался повторить все что они там делают и также на Форме (Пример ссылки: http://thedelphi.ru/les-opengl.php ), но так же дальше раскраски фона не ушло.
Задача, есть очень много разных объектов(точки, треугольники, квадраты, круги, полилинии и т.д.) доходит их число до 500 млн. и бывает даже больше использования обычной отрисовки через canvas даже в буфере на bitmap, а потом переносится на Image, рисует очень долго, было решение использовать OpenGL, но как то ничего не получается.

Код попыток вывести на bitmap делаю так:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
procedure TPaint.drawOGLM();
var
  i: Integer;
  bmp: TBitmap;
begin
  //------------------------------------------- Задаем начальные параметры
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24bit;
  bmp.Width := Img.Canvas.Width;
  bmp.Height := Img.Canvas.Height;
 
  SetDCPixelFormat(bmp.Canvas.Handle, Palette, True);
  glDepthFunc(GL_LEQUAL);   // тип проверки
  hrc := wglCreateContext(bmp.Canvas.Handle);  //Выделяем контекст устройства
  wglMakeCurrent(bmp.Canvas.Handle, hrc);      //
  glViewPort(0,0, bmp.Width, bmp.Height);
  //---------------------------------------------- Отрисовка фона
  glClearColor(210/255, 210/255, 210/255, 1.0); //Цвет фона
  glClear(GL_COLOR_BUFFER_BIT); // Очистка буфера цвета и глубины // or GL_DEPTH_BUFFER_BIT
  wglMakeCurrent(0, 0);
  //glEnable(GL_DEPTH_TEST);
  //---------------------------------------------- Отрисовка разных объектов
  //glMatrixMode(GL_PROJECTION);  // Фрагмент был в одном из премеров, но не чего не изменилось
  //glLoadIdentity;
  //gluPerspective(45, bmp.Width/bmp.Height, 1, 100);
  //glMatrixMode(GL_MODELVIEW);
  //glLoadIdentity;
  //glTranslatef(0.0,0.0,-5.0);
 
  for i := 0 to 10 do
  begin
    glPointSize(5);
    glBegin(GL_POINT);
    glColor3f(Random,Random,Random);
    glVertex3f(Random, Random, Random);
    glEnd;
  end;
//
  glEnable(GL_LINE_SMOOTH);
  glLineWidth(4); // задаем толщину линий
  glBegin(GL_LINES);
  for i:=1 to 20 do
  begin
    // задаем случайный цвет каждой вершины
    glColor3f(Random,Random,Random);
    glVertex2f(Random(800),Random(600));
  end;
  glEnd;
//
  glFinish;
  glFlush;
  SwapBuffers(bmp.Canvas.Handle);
  Img.Canvas.Draw(0, 0, bmp); 
end;

Вот функция SetDCPixelFormat:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
procedure TPaint.SetDCPixelFormat(DC: THandle; var Palette: HPalette; ToBitmap: Boolean);
var
  hHeap: THandle;
  nColors, I: Integer;
  lpPalette: PLogPalette;
  byRedMask, byGreenMask, byBlueMask: Byte;
  nPixelFormat: Integer;
  pfd: TPixelFormatDescriptor;
begin
  FillChar(pfd, SizeOf(pfd), 0);
  with pfd do
  begin
    nSize := sizeof(pfd);
    nVersion := 1;
    if ToBitmap then
      dwFlags := PFD_DRAW_TO_BITMAP or PFD_GENERIC_ACCELERATED or PFD_SUPPORT_OPENGL
    else
      dwFlags := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 24;
    cDepthBits := 32;
    iLayerType := PFD_MAIN_PLANE
  end;
  nPixelFormat := ChoosePixelFormat(DC, @pfd);
  SetPixelFormat(DC, nPixelFormat, @pfd);
  DescribePixelFormat(DC, nPixelFormat, SizeOf(TPixelFormatDescriptor), pfd);
  if (pfd.dwFlags and PFD_NEED_PALETTE) <> 0 then
  begin
    nColors := 1 shl pfd.cColorBits;
    hHeap := GetProcessHeap;
    lpPalette := HeapAlloc(hHeap, 0, SizeOf(TLogPalette) + (nColors*SizeOf(TPaletteEntry)));
    lpPalette^.palVersion := $300;
    lpPalette^.palNumEntries := nColors;
    byRedMask := 1 shl pfd.cRedBits-1;
    byGreenMask := 1 shl pfd.cGreenBits-1;
    byBlueMask := 1 shl pfd.cBlueBits-1;
    for i := 0 to nColors-1 do
    begin
      lpPalette^.palPalEntry[I].peRed := (((I shr pfd.cRedShift) and byRedMask)*255) div byRedMask;
      lpPalette^.palPalEntry[I].peGreen := (((I shr pfd.cGreenShift) and byGreenMask)*255) div byGreenMask;
      lpPalette^.palPalEntry[I].peBlue := (((I shr pfd.cBlueShift) and byBlueMask)*255) div byBlueMask;
      lpPalette^.palPalEntry[I].peFlags := 0
    end;
    Palette := CreatePalette(lpPalette^);
    HeapFree(hHeap, 0, lpPalette);
    if Palette <> 0 then
    begin
      SelectPalette(DC, Palette,False);
      RealizePalette(DC)
    end;
  end;
end;

После выполнения закрашивается только фон, и больше ничего не происходит. Я только начал познавать возможности OpenGL не судите строго.

murderer · 12.03.2019, 07:45

Попробуй перед рисованием отключить проверку глубины

Pascal
1
glDisable(GL_DEPTH_TEST);

Добавлено через 9 минут
Видимо это лишнее

Pascal
1
wglMakeCurrent(0, 0)

@Jomaxplayer · 12.03.2019, 09:44 **[ТС]**

murderer

Попробуй перед рисованием отключить проверку глубины

Видимо это лишнее

Спасибо, попробовал, но ничего не происходит, только фон закрашивается, это опробовал как на Bitmap так и на форме. Так к примечанию, может что даст, пишу в RadStudio 10.3

Я наткнулся на то как люди работают с библиотекой не openGL, а с dglOpenGL, опробовал, она работает только с формой, с bitmap она не работает.
У меня в проекте огромное количество компонент, разного взаимодействующего кода, заходит за 100 тыс строк. Хочется избежать от перевода рисования на форму, а сделать все через bitmap.
Или bitmap для openGL, это плохая идея?

murderer · 12.03.2019, 14:21

Вот слепил из твоего кода нечто рабочее (система координат приведена к привычному виду при помощи gltranslatef и glscalef).

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
var
  pfd: TPixelFormatDescriptor=(nSize     :sizeof(pfd);
                               nVersion  :1;
                               dwFlags   :PFD_DRAW_TO_BITMAP or PFD_GENERIC_ACCELERATED or PFD_SUPPORT_OPENGL;
                               iPixelType:PFD_TYPE_RGBA;
                               cColorBits:24;
                               cDepthBits:32;
                               iLayerType:PFD_MAIN_PLANE);
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  bmp: TBitmap;
  DC,nPixelFormat: Cardinal;
begin
  bmp := TBitmap.Create;
  bmp.PixelFormat := pf24bit;
  bmp.Width := Img.ClientWidth;
  bmp.Height := Img.ClientHeight;
  DC:=bmp.Canvas.Handle;
 
  nPixelFormat := ChoosePixelFormat(DC, @pfd);
  SetPixelFormat(DC, nPixelFormat, @pfd);
  DescribePixelFormat(DC, nPixelFormat, SizeOf(TPixelFormatDescriptor), pfd);
  wglMakeCurrent(DC, wglCreateContext(DC));
  glViewPort(0,0, bmp.Width, bmp.Height);
  glTranslatef(-1,1,0);
  glScalef(2/bmp.Width,-2/bmp.Height,0);
 
  glClearColor(210/255, 210/255, 210/255, 1.0);
  glClear(GL_COLOR_BUFFER_BIT);
 
  glEnable(GL_LINE_SMOOTH);
  glLineWidth(1);
  glBegin(GL_LINES);
  for i:=1 to 20 do
  begin
    glColor3f(random,random,random);
    glVertex2f(0,i*10);
    glVertex2f(bmp.Width,i*10);
  end;
  glEnd;
 
  glFlush;
  SwapBuffers(DC);
  Img.Canvas.Draw(0, 0, bmp);
end;

@Jomaxplayer · 12.03.2019, 16:27 **[ТС]**

murderer

Блин огромное тебе спасибо, скажи пожалуйста, что ты сделал? В ручную сделал палитру а не в функции как у меня, какие то другие параметры указал?

Delphi
1
2
3
4
5
6
7
 pfd: TPixelFormatDescriptor=(nSize     :sizeof(pfd);
                               nVersion  :1;
                               dwFlags   :PFD_DRAW_TO_BITMAP or PFD_GENERIC_ACCELERATED or PFD_SUPPORT_OPENGL;
                               iPixelType:PFD_TYPE_RGBA;
                               cColorBits:24;
                               cDepthBits:32;
                               iLayerType:PFD_MAIN_PLANE);

Я как понимаю, вот эта строчка приводит к тому виду задания координат

Delphi
1
glScalef(2/bmp.Width,-2/bmp.Height,0);

А что делает эта?

Delphi
1
glTranslatef(-1,1,0);

Поделись секретом, я сколько не читал куда не смотрел, так и не понял в чем фишка. Может есть какая литература?

murderer · 13.03.2019, 03:57

По умолчанию система координат такая

Как с помощью OpenGL рисовать на TBitmap?

Координаты изменяются от -1 до 1, ось y направлена снизу вверх.

murderer · 13.03.2019, 04:05

Я привёл к такому виду

Но это не значит, что так нужно делать всегда. Система координат выбирается в соответствии с поставленной задачей.

@ILinker · 13.03.2019, 11:32

Рисовани в битмап - уже деприкейтед.

Лучше рисуйте в RenderTarget

@Jomaxplayer · 13.03.2019, 12:03 **[ТС]**

murderer

По умолчанию система координат такая

Да я все это понимаю. Просто я не натыкался на то что люди, а точнее какой именно командой переводили из одной системы координат в привычную ту, которая изначально в Canvas.

Новые блоги и статьи Все статьи Все блоги /
Новый CodeBlocs. Версия 25.03 palva 04.01.2026 Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .	Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Programma_Boinc 01.01.2026 Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Сочетание глобально распределённой вычислительной мощности и инновационных. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .
Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .	PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .

murderer 4189 / 1837 / 220 Регистрация: 06.10.2010 Сообщений: 4,124
	13.03.2019, 03:57
	По умолчанию система координат такая Координаты изменяются от -1 до 1, ось y направлена снизу вверх. 0

murderer 4189 / 1837 / 220 Регистрация: 06.10.2010 Сообщений: 4,124
	13.03.2019, 04:05
	Я привёл к такому виду Но это не значит, что так нужно делать всегда. Система координат выбирается в соответствии с поставленной задачей. 0

@ILinker Фриланс Pascal/Delphi etc 67 / 73 / 16 Регистрация: 25.11.2016 Сообщений: 263
	13.03.2019, 11:32
	Рисовани в битмап - уже деприкейтед. Лучше рисуйте в RenderTarget 0

Как с помощью OpenGL рисовать на TBitmap?

Решение