OpenGl Рисуем в Фоне, возможно ли?

[Maxizar]

Имеется самописный класс для вывода графиков через OpenGL, все работает отработатно и тп. Изночально была проблема вывода на поверхность Image, OpenGL иногда просто не видел Хэндл канвы от Image и тп. Гугл в свое время дал понять, что OpenGL не любит вывод на компаненты, и тем более на те для которых как бы не создается окно, Решил так ставим Panel, на ее канве OpenGL рисует вроде айс, после чего просто копирую график на Image и ок. Почему используется Image, его не нужно перерисовывать (ну скажем когда закрыли окно другим приложением).
Почему это критично: иногда требуется нарисовать график для постера и тп, те он чисто физически не помещаеться на мониторе (те используеться ScrollBox), те при прокрутке которого Image нам и помогаетю

Задачка: Нужно обрабатывать данные (массив точек), в фоне и после чего сохронять картинку в файл, Но OpenGL, просто не рисует потому что окно скрыто, Как это победить. Окно показывать нельзя. Можно каким то макаром создать вертуальную Канву на ней рисовать OpenGL-ем и уже обрабатывать данную канву как мне нужно.
-Предлогать сторонние компаненты не надо.

Заранее Спасибо..

[скалогрыз]

Задачка: Нужно обрабатывать данные (массив точек), в фоне и после чего сохронять картинку в файл, Но OpenGL, просто не рисует потому что окно скрыто, Как это победить. Окно показывать нельзя. Можно каким то макаром создать вертуальную Канву на ней рисовать OpenGL-ем и уже обрабатывать данную канву как мне нужно.
-Предлогать сторонние компаненты не надо.

1й способ) Под Windows так же поддерживается OpenGL отрисовка в Bitmap. (т.е. Хендл берётся от некого окна, а DC берётся от Bitmap), работает ли это на всех драйверах я не пробовал и ничего гарантировать не могу.

2й способ) Выполнять отрисовку OpenGL можно начать в любой момент, главное, чтобы существовал Handle окна и DC контекста.
Но факт в том, что DC можно получить и от невидимого окна и рисовать в невидимое окно можно.
Т.е. если нужно рисовать (не обязательно в Paint событии), выполняем

Код: Выделить всё

GetDC..
SetCurrentContext..
рисуем
SetCurrentContext(nil,nil);
ReleaseDC;


после чего копируем с DC в Image.

3й способ) Вообще мутить с DC не обязательно, можно использовать glReadPixels которые читает пиксели из буфера отрисовки OpenGL. После чтения буфера отрисовки, пиксели можно положить в bmp картинку и сохранить в файл.

4й способ) ***СОВРЕМЕННЫЙ*** Используется расширение FBO. OpenGL рисует в некий кусок текстуры (читай буфер памяти), после чего из этого буфера пиксели записываются в bmp картинку и сохраняются в файл.

4ый способ работает быстрее, чем 3ий. Опят же для 3 и 4 способов, нужно окно (даже не видимое, и не обязательно Panel) - для создания контекста OpenGL.

ЗЫ: Не в обиду, но вы, ребят, тонкие извращенцы!!!!

ЗЗЫ: Мне тут подсказывают, что если ни один из выше перечисленных способов вам не подходит, вы можете использовать СВОЙ существующий код, но при этом окно, в которое рисуется OpenGL находится на вне экрана, например с координатами X: -MaxInt Y: -MaxInt.

[Maxizar]

Так вот:
Главная форма:

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Image1: TImage;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation
   Uses Windows,Gl,  glinit,Unit2,Unit3;
{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
    hrc: HDC; // ссылка на контекст воспроизведения
begin
    initGL(hrc,Panel1.Canvas.Handle,True);//Инициализация Open GL

   glLineWidth(5); // размер точек

   glColor3ub(255,0,0); // цвет примитивов

   glBegin(GL_LINES); // открываем командную скобку,
   glVertex2f(-1,-1);
   glVertex2f(1,1);
   glEnd; //Закрываем командную скобку GL

   Image1.Canvas.CopyRect(Image1.Canvas.ClipRect,
                           Panel1.Canvas,
                           Panel1.Canvas.ClipRect);
   //Если Панель видимая то все ок, то на  mage1 идет копирование линии
   //но если мы поставим
   //Panel.Visible:=False, то все тот же черный квадрат ...
   //Те мы как бы нарисовали на панели черный квадрат и его скопировали :(
    FreeGL(hrc);                  //Освобождение Контекста GL

end;

procedure TForm1.Button2Click(Sender: TObject);
var
    hrc: HDC; // ссылка на контекст воспроизведения
    Form:TForm2;
begin

    Form:=TForm2.Create(Self);
    form.Top:=-1000;
    Form.Left:=-1000;
    Form.Show;
    initGL(hrc,Form.Canvas.Handle,True);//Инициализация Open GL

   glLineWidth(5); // размер точек

   glColor3ub(255,0,0); // цвет примитивов

   glBegin(GL_LINES); // открываем командную скобку,
   glVertex2f(-1,-1);
   glVertex2f(1,1);
   glEnd; //Закрываем командную скобку GL

   Image1.Canvas.CopyRect(Image1.Canvas.ClipRect,
                           Form.Canvas,
                           Form.Canvas.ClipRect);
   //Черный квадрат чтоб его

   FreeGL(hrc);                  //Освобождение Контекста GL
    //Form.FreeOnRelease;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  //Unit3.Form3.Left:=-1000;  // - 1
  //Unit3.Form3.Top:=-1000;   // - 2
  Unit3.Form3.Show;           // - 3
  Unit3.Form3.Draw;           // - 4

  Image1.Canvas.CopyRect(Image1.Canvas.ClipRect,
                           Unit3.Form3.Canvas,
                           Unit3.Form3.Canvas.ClipRect);
//Рабочий вариант, который не устраивает
//Если вкл 1 и 2 то рисуется черный квадрат
//Если выключить 3 то тот же черный квадрат
//работает когда вкл 3,4 и откл 1,2 но мне как раз нужно
//форму скрыть... (
end;

end.



Модуль Unit2 содержит стандартную форму.

Модуль Unit3 содержит форму с таким вот содержанием:

Код: Выделить всё

unit Unit3;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls;

type

  { TForm3 }

  TForm3 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { private declarations }
  public
    Procedure Draw;
    { public declarations }
  end;

var
  Form3: TForm3;

implementation
  Uses GL,GLInit,Windows;
{$R *.lfm}

{ TForm3 }

procedure TForm3.FormPaint(Sender: TObject);
begin
  Draw;
end;

procedure TForm3.Draw;
  var
    hrc: HDC; // ссылка на контекст воспроизведения
begin
   initGL(hrc,Canvas.Handle,True);//Инициализация Open GL
   glLineWidth(5); // размер точек
   glColor3ub(255,0,0); // цвет примитивов
   glBegin(GL_LINES); // открываем командную скобку,
   glVertex2f(-1,-1);
   glVertex2f(1,1);
   glEnd; //Закрываем командную скобку GL

    FreeGL(hrc);                  //Освобождение Контекста GL

end;

procedure TForm3.Button1Click(Sender: TObject);
begin
  Draw;
end;

end.


Содержание модуля GlInit:

Код: Выделить всё

unit GLinit;

{$mode objfpc}{$H+}

interface

uses
  Classes,windows, SysUtils, GL;

  procedure initGL(ContextHandle:HDC; Const CanvasHandle:HDC;
                   Const Smooth:Boolean);
  procedure FreeGL(Const ContextHandle:HDC);

implementation
//------------------------------------------------------------------//
procedure initGL(ContextHandle: HDC; const CanvasHandle: HDC;
  const Smooth: Boolean);
  //Процедура инициализации Open GL для контекста ContextHandle на
  // Конве CanvasHandle, Smooth - указывает нужно ли установить Сглаживание
Procedure SetDCPixelFormat(Const _hdc: HDC);
{Процедура установки формата пикселя для контекста _hdc}
var
  pfd: TPixelFormatDescriptor;
  nPixelFormat: Integer;
begin
    FillChar(pfd, SizeOf(pfd), 0);
    nPixelFormat:=ChoosePixelFormat(_hdc, @pfd);
    SetPixelFormat(_hdc, nPixelFormat, @pfd);
end;

begin

SetDCPixelFormat(CanvasHandle); //задаем формат пиксела
ContextHandle := wglCreateContext(CanvasHandle); // создаем контекст воспроизведения
wglMakeCurrent(CanvasHandle, ContextHandle); // установить контекст
//glEnable(PFD_DOUBLEBUFFER);

  if Smooth then //нужно сглаживание
   begin
     //  glHint( GL_LINE_SMOOTH_HINT, GL_NICEST );
    glEnable(GL_LINE_SMOOTH);
    glEnable(GL_BLEND);
    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);   //Сглаживание
   end;
end;
//------------------------------------------------------------------//
procedure FreeGL(const ContextHandle: HDC);
begin
SwapBuffers(ContextHandle);
wglMakeCurrent(0, 0); // освободить контекст
wglDeleteContext(ContextHandle);
end;
//------------------------------------------------------------------//
end.


Как написано в исходнике 1 а именно в Нажатии Кнопки3:
Работает все это дело при видимости формы или Панели, что как раз и не нужно
Придется работать с 3 и 4 вариантами как предложил (скалогрыз)
Если кто то знает в чем я накасячил то отпишитесь. Может быть я не правильно инициализирую Gl, хотя ведь он рисует
при видимости формы..., Короче я в тупике.

[Maxizar]

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

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes,Windows, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, ExtCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    ScrBitmap: TBitmap;  //наш битмап
    Scr: Pointer;        //указатель на массив битов в ОЗУ
    SX, SY: Integer;     //ну даже не знаю как и сказать :) размеры

   procedure CreateBitmap(aSX, aSY: Integer);
   procedure DeleteBitmap;
    { private declarations }
  public
    { public declarations }
  end;

type

    TDibPoints = array[0..0] of Integer;  //необходим если хотим играть с Массивом точек
var
  Form1: TForm1;

implementation

Uses GL, glinit;
{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
   CreateBitmap(1000, 1000);
  Image1.Canvas.Draw(0, 0, ScrBitmap);
  Caption := 'Визуализатор';
  Application.Title := Caption;
end;

procedure TForm1.Button1Click(Sender: TObject);
var  x, y: Integer;
begin
  // В цикле рисуется так называемый шум :)
  for x := 0 to SX - 1 do
    for y := 0 to SY - 1 do
      TDibPoints(Scr^)[x + y * SX] := RGB(Random(256), Random(256),Random(256));


  Image1.Picture.Bitmap.Canvas.Draw(0, 0, ScrBitmap);  //запись в имидж
end;

procedure TForm1.Button2Click(Sender: TObject);
var hrc:HDC;
begin
   initGL(hrc,ScrBitmap.Canvas.Handle,True);

   glLineWidth(9); // размер точек

   glColor3ub(255,0,0); // цвет примитивов

   glBegin(GL_LINES); // открываем командную скобку,
   glVertex2f(-1,-1);
   glVertex2f(1,1);
   glEnd; //Закрываем командную скобку GL

    glFlush(); //Равносилен SwapBuffers(ContextHandle); тока для битмпапа похду
    Image1.Canvas.Draw(0, 0, ScrBitmap);
   // ScrBitmap.SaveToFile('C:\Ura.bmp'); //ну можно сохронить елси нуна
   FreeGL(hrc);            //освобождение контекстов

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteBitmap();
end;

procedure TForm1.CreateBitmap(aSX, aSY: Integer);
  var
  BInfo: BITMAPINFO;
begin
  // Создание DIB
  SX := aSX;
  SY := aSY;
  BInfo.bmiHeader.biSize := sizeof(BITMAPINFOHEADER);
  BInfo.bmiHeader.biWidth := SX;
  BInfo.bmiHeader.biHeight := -SY;
  BInfo.bmiHeader.biPlanes := 1;
  BInfo.bmiHeader.biBitCount := 32;
  BInfo.bmiHeader.biCompression := BI_RGB;

  ScrBitmap := TBitmap.Create();
  ScrBitmap.PixelFormat:=pf32bit;
  ScrBitmap.HandleType:=bmDIB;
  ScrBitmap.Handle := CreateDIBSection(Canvas.Handle, BInfo, DIB_RGB_COLORS,
    Scr, 0, 0);
  ZeroMemory(Scr, SX * SY * 2);

end;


procedure TForm1.DeleteBitmap;
begin
  // Удаление DIB
  ScrBitmap.FreeImage();
  ScrBitmap.Destroy;
end;

end.
{Общие замечания если хотим 16 бит то должны поменять вот эти значение
BInfo.bmiHeader.biBitCount := 32; на  BInfo.bmiHeader.biBitCount := 16
ScrBitmap.PixelFormat:=pf32bit; на    ScrBitmap.PixelFormat:=pf16bit
pfd.cColorBits  :=32;           на    pfd.cColorBits  :=16;
pfd.cDepthBits  :=32;           на    pfd.cDepthBits  :=16;
и тип TDibPoints = array[0..0] of Integer;  будет уже не Integer а Word
те TDibPoints = array[0..0] of Word;

аналогично с 24 битами и тп :)
}



Код модуля glinit:

Код: Выделить всё

unit GLinit;


interface

uses
  Classes,windows, SysUtils,GL;

  procedure initGL(ContextHandle:HDC; Const CanvasHandle:HDC;
                   Const Smooth:Boolean);
  procedure FreeGL(Const ContextHandle:HDC);

implementation
//------------------------------------------------------------------//
procedure initGL(ContextHandle: HDC; const CanvasHandle: HDC;
  const Smooth: Boolean);
  //Процедура инициализации Open GL для контекста ContextHandle на
  // Конве CanvasHandle, Smooth - указывает нужно ли установить Сглаживание
Procedure SetDCPixelFormat(Const _hdc: HDC);
{Процедура установки формата пикселя для контекста _hdc}
var
  pfd: TPixelFormatDescriptor;
  nPixelFormat: Integer;
begin
    FillChar(pfd, SizeOf(pfd), 0);

    pfd.nSize       :=SizeOf(TPixelFormatDescriptor);
    pfd.nVersion    :=1;
    pfd.dwFlags:=PFD_DRAW_TO_BITMAP or PFD_SUPPORT_OPENGL or
                 PFD_GENERIC_ACCELERATED;
    pfd.iPixelType  :=PFD_TYPE_RGBA;
    pfd.cColorBits  :=32;
    pfd.cDepthBits  :=32;
    pfd.iLayerType  :=PFD_MAIN_PLANE;

   //
    nPixelFormat:=ChoosePixelFormat(_hdc, @pfd);
    SetPixelFormat(_hdc, nPixelFormat, @pfd);
end;

begin

SetDCPixelFormat(CanvasHandle); //задаем формат пиксела
ContextHandle := wglCreateContext(CanvasHandle); // создаем контекст воспроизведения
wglMakeCurrent(CanvasHandle, ContextHandle); // установить контекст


  if Smooth then //нужно сглаживание
   begin
     //  glHint( GL_LINE_SMOOTH_HINT, GL_NICEST );
    glEnable(GL_LINE_SMOOTH);
    glEnable(GL_BLEND);
    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);   //Сглаживание
   end;
end;
//------------------------------------------------------------------//
procedure FreeGL(const ContextHandle: HDC);
begin
// SwapBuffers(ContextHandle);
wglMakeCurrent(0, 0); // освободить контекст
wglDeleteContext(ContextHandle);
end;
//------------------------------------------------------------------//
end.


[Timid]

2Maxizar

Вы кажется не очень поняли комментарий скалогрыза.
Настоятельно не рекомендуется рисовать в обычную память средствами OpenGL, поскольку она не может быть залочена средствами драйверов экрана - через них и работает OGL в Windows, к примеру, если будет включено аппаратное ускорение, а вы ускорение и не отключали
Поэтому битмап может быть перемещен менеджером памяти и контекст вывода будет потерян.

И кстати, чем вас TeeChart не устраивает?

[Alex2013]

Кстати столкнулся с похожей проблемой нужно сделать вывод для 3д-модели поверх видео потока в "дополненной реальности " и... вернуть поток обратно программе ! (Первую часть успешно решил )

(Вместо фона(карты мира ) может идти видео поток )
А вот вернуть обратно проблема !
Зы
По "страхам": если действовать в пределах одного кадра (получил дескриптор, нарисовал на нем кадр, извлек кадр, освободил дескриптор ) то система банально не успеет что-либо изменить .

[olegy123]

Задачка: Нужно обрабатывать данные (массив точек), в фоне и после чего сохронять картинку в файл, Но OpenGL, просто не рисует потому что окно скрыто, Как это победить. Окно показывать нельзя. Можно каким то макаром создать вертуальную Канву на ней рисовать OpenGL-ем и уже обрабатывать данную канву как мне нужно.
-Предлогать сторонние компаненты не надо.

Рисуешь сцену в glFramebufferTexture2D - то есть в текстуру..
Выводишь эту текстуру как RGB массив, лучше делать это через FBO() далее делай что хошь..

если нужно в фоне без окошек - то только Vulkan. Или в Linux в Mesa есть такой режим.

[Alex2013]

Способ "от Maxizar-ра" работает но почему-то только в 2д....
Что странно ....

Код: Выделить всё

procedure TForm1.Button2Click(Sender: TObject);
var CanvasHandle,hrc:HDC;
   pfd: TPixelFormatDescriptor;
  nPixelFormat: Integer;
begin
     initGL(hrc,ScrBitmap.Canvas.Handle,True);
// так работает
   glLineWidth(9); // размер точек

   glColor3ub(255,0,0); // цвет примитивов

   glBegin(GL_LINES); // открываем командную скобку,
   glVertex2f(-1,-1);
   glVertex2f(1,1);
   glEnd; //Закрываем командную скобку GL
// так не работает (точнее не показывает   )...
{-----------------------
  glLineWidth(1);
   glBegin(GL_QUADS);
          glColor3f(0.0,1.0,0.0);                       // Set The Color To Green
          glVertex3f( 0.5,0.5,-0.5);                  // Top Right Of The Quad (Top)
          glVertex3f(-0.5, 0.5,-0.5);                  // Top Left Of The Quad (Top)
          glVertex3f(-0.5, 0.5, 0.5);                  // Bottom Left Of The Quad (Top)
          glVertex3f( 0.5, 0.5, 0.5);                  // Bottom Right Of The Quad (Top)
  glEnd();
   glPopMatrix;
--------------------------}
    glFlush(); //Равносилен SwapBuffers(ContextHandle);  для битмпапа
    Image1.Canvas.Draw(0, 0, ScrBitmap);
   // ScrBitmap.SaveToFile('C:\Ura.bmp'); //ну можно сохронить елси нуна
   FreeGL(hrc);            //освобождение контекстов
end;



[zub]

В очередной раз убеждаюсь что Alex2013 это бот, он недумывая перепощивает куски кода, ставит странные задачи и выдает решения не про то

Это же типиичный opengl хеловорд, причем без инициализации матриц... Таких кусков в любом уроеке по инициализации гл пруд пруди. При чем тут в фоне? "трехмерный" фрагмент загадочным образом заработает если будешь даже не думать, а хотябы смотреть что ты копипастишь

[Alex2013]

Ну извини я просто не в теме по OpenGl почти "от слова совсем". А что до странностей ... то уважаемый Зуб вы уже которой раз отвечаете на конкретный вопрос "в духе мудрого сказочного персонажа".
Ну не нашел я решения и спросил . Лень не отвечай..
Извини переоценил "глубину вашей дедукции" , а вы переоценили мои знания вопроса . Снобизм то причем ?

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

Но догадаться, что код для триди рисования "предан в абстрактной форме" просто из экономии места в "умно и вкусно думающую голову" не приходит ?

Разумеется, я проверял с полной копией рабочей "рисковалки куба" ... но "Формальная зубо-логика" этого понять не позволяет !
(Теперь буду расписывать "в пошаговом режиме" что-бы даже сквозь "Зубо-эмуляцию бота" прошло... )
Уф !
Повторяю если можно кинь мне любой фрагмент рабочего кода с построением триди именно в этом примере.

Да, я понимаю , что я там скорее всего упустил что-то совсем простое . Но никто родится с врожденным знанием OpenGL, а я только только добрался хоть какой-то загрузки своих моделей и уровня "знаний OpenGL" позволяющего мне успешно воспроизводить и кобинировать часть простейших примеров (раньше я даже этого не мог) . Но поскольку мне нужно непросто "разобраться с OpenGL" , а конкретный небольшой фрагмент для другой задачи , то ждать "возвышенного уровня постижения " было бы пустой тратой времени .
Короче, "по мотивации" вроде все ясно ...
Теперь повторю конкретный вопрос : Как заставить работать код между ..

Код: Выделить всё

begin
     initGL(hrc,ScrBitmap.Canvas.Handle,True);


...

Код: Выделить всё

   FreeGL(hrc);            //освобождение контекстов
end;


..с 3Д примитивом ...( У меня это не получилось, хотя я вставлял (не частями, а целиком) полностью рабочий код из другого примера )

[zub]

У тебя явный переизбыток кавычек в посте. Хочешь чтобы тебя воспринимали всерьез - завязывай так.

>>Теперь повторю конкретный вопрос : Как затравить работать код между
твои вопросы вызваны абсолютным незнание целевой области. Потрудись сначала ознакомиться с какими нибудь статьями для чайников.

Код: Выделить всё

initGL(hrc,ScrBitmap.Canvas.Handle,True);

ЕМНИП нет такой функции в opengl, соответственно это какойто самописный кусок говнокода?

стати столкнулся с похожей проблемой нужно сделать вывод для 3д-модели поверх видео потока в "дополненной реальности " и... вернуть поток обратно программе ! (Первую часть успешно решил )

С чем столкнулся и что решил если ты элементарно контекст инициализировать несумел?

Добавлено спустя 2 минуты 30 секунд:
Ответом на все твои вопросы в топике будет: изучай уроки "OpenGL для чайников", когдато давно были популярными такие статьи от некоего NEHE, что там в моде сейчас - хз

[Alex2013]

1 Мене глубоко плевать есть ли это в OpenGl или нет... и чей и чего это кусок ... Он работает !
2 Я просто постыдился выкладывать не относящеюся к вопросу свой пробный и на этот раз совершенно точно "Г-код". Но скрин не подделка .
(и кроме-того думал что для "гуру" это уж всем "проще простого" )
3 Из всех вариантов найденных мной в Сети "Способ от Maxizar-ра"(от туда взяты initGL и FreeGL) пока единственный "условно рабочий".
(Попытки его "причесать" пока ни к чему хорошему не привели )
4 Разуметься в теме OGL я почти 0 без палочки. Но ответ мне нужен сейчас, а не "после постижения бездны премудрости" .
(Примеров у меня натянуто из сети КУЧА ... часть даже заставил работать в Лазарусе... но понимание пока "где-то там" )

Задача в моем первом посте : Битмап -> Фон OGL-> вывод модели на OGL контекст -> возвращение содержимого контекста в TBitMap .
ВСЕ !
(Вывод модели я худо бедно осилили )

[zub]

>>1 Мене глубоко плевать есть ли это в OpenGl или нет... и чей и чего это кусок ... Он работает !
...
>>4 Разуметься в теме OGL я почти 0 без палочки. Но ответ мне нужен сейчас, а не после постижения бездны премудрости .
Так небывает. Програмирование - это огромная куча рутины.
Конечно знать\понимать абсолютно все в вопросе не получится, но основы понимать надо. Потратить неделю на освоение гораздо проще чем нащипать по верхушкам, надергать с инета и тратить месяцы на глупые вопросы. Причем получая нормальные ответы на свои вопросы, почемуто упорно проболжать утверждать - а вот это непойми что непойми как работает, проблема "решена"

[Alex2013]

>>1 Мене глубоко плевать есть ли это в OpenGl или нет... и чей и чего это кусок ... Он работает !
...
>>4 Разуметься в теме OGL я почти 0 без палочки. Но ответ мне нужен сейчас, а не после постижения бездны премудрости .
Так небывает. Програмирование - это огромная куча рутины.
Допускаю что знать\понимать абсолютно все в вопросе не получится, но основы понимать надо. Потратить неделю на освоение гораздо проще чем нащипать по верхушкам, надергать с инета и тратить месяцы на глупые вопросы. Причем получая нормальные ответы на свои вопросы, почемуто упорно проболжать утверждать - а вот это непойми что непойми как работает, проблема "решена"

Потом я разумеется планирую разобраться "углубленно" но для конкретного проекта который я толкаю просто "для души" это через чур ДОЛГО и несообразно, там OGL даже не вспомогательный, а совсем уж "служебный" кусок кода (Туда и "софт движок " с "закраской Гуро" вполне с избытком пойдет . Нужно вывести ОДНУ ПРОСТУЮ МОДЕЛЬ.... Просто по походу исследования "Цифровой оптики" мне пришло в голову "О неплохо бы сделать чуть красивее" И ВСЕ ! ) .

Отсюда и сакраментальный вопрос " Нафига козе боян !" Так что если цена вопроса "в часах" станет чуть больше я вполне обойдусь БЕЗ OpenGL !
(Модели "в сеточку" программа уже сейчас строит без всякого OGL ... )
Ps
"Не пойми что" мне как раз понятно ... Создается специальный битмап с нужными атрибутами ...
(Обычный не получается назначить "контекстом OGL" панель или форму можно, а "виртуальный" битмап в памяти нет. )
Потом делается вот что:
ContextHandle := wglCreateContext(CanvasHandle); // создаем контекст воспроизведения

И совсем уж стандартный :
wglMakeCurrent(CanvasHandle, ContextHandle); // установить контекст

ВСЕ !

[Alex2013]

Вообщем кое-чего я все же добился ...


Кнопка 1: Заполнение шумом ...
Кнопка 2: "Чистый тест "+ попытка юзать GetBimap ..
Кнопка 3: Аналог "Способа Maxizar-ра" - рисует на "фоновом" битмапе. (сделал чуть менее "загадочно")
Галка : Включает "3д режим" для "Кнопки 3"
В общем почти понял почему не работало раньше ... Но проблемы остались !

Проблемы:
1 Кнопка 2 GetBimap "что-то" выдает но вот что именно непонятно ...
2 Кнопка 3 "2д режим" работает нормально, а "3д режим" только с очисткой контекста ..
3 Кнопка 3 "3д режим " Наблюдается "Сдвиг по фазе" ( Нуль координат болтается неизвестно где )
( получилось кое как нивелировать его настройкой матрицы glTranslatef(-6.5, -6.5,-9.0); и gluPerspective(90, w / h, 0.1, 50.0); но пропорции (как видно на скрине ) "того" !)


Полный код модуля формы(Ничего другого кроме стандартных модулей не нужно )
GLForm.pas

Код: Выделить всё


unit GLForm;


{$mode objfpc}{$H+}

interface

uses
  Windows, Messages, SysUtils, Classes, GL,GLU,GlExt, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, OpenGLContext;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    CheckBox1: TCheckBox;
    Image1: TImage;
    OpenGLControl1: TOpenGLControl;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    Procedure MyPaint01(w ,h:Integer);
  private
    ScrBitmap: TBitmap;  //наш битмап
    Scr: Pointer;        //указатель на массив битов в ОЗУ
    SX, SY: Integer;     //ну даже не знаю как и сказать :) размеры

   procedure DeleteBitmap;
    { private declarations }
  public
    cube_rotation: GLFloat;
    Speed:          Double;

    { public declarations }
  end;

type

    TDibPoints = array[0..0] of byte;  //необходим если хотим играть с Массивом точек
var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
//Собственно "рисовалка куба"  (да это копия какого-то примера)... 
Procedure Tform1.MyPaint01(w ,h:Integer);
begin
//glClearColor(1.0, 1.0, 1.0, 1.0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glEnable(GL_DEPTH_TEST);

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  if not CheckBox1.Checked then begin
    // так понятно
    gluPerspective(45.0, width / height, 0.1, 50.0);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity();
    glTranslatef(0.0, 0.0,-6.0);
  end else
  begin
  // так не понятно
   gluPerspective(90, w  / h, 0.1, 50.0);
   glMatrixMode(GL_MODELVIEW);
   glLoadIdentity();
   glTranslatef(-6.5, -6.5,-9.0);
  end;
  glRotatef(cube_rotation, 1.0, 1.0, 1.0);
  glBegin(GL_QUADS);
          glColor3f(0.0,1.0,0.0);                              // Set The Color To Green
          glVertex3f( 1.0, 1.0,-1.0);                  // Top Right Of The Quad (Top)
          glVertex3f(-1.0, 1.0,-1.0);                  // Top Left Of The Quad (Top)
          glVertex3f(-1.0, 1.0, 1.0);                  // Bottom Left Of The Quad (Top)
          glVertex3f( 1.0, 1.0, 1.0);                  // Bottom Right Of The Quad (Top)
  glEnd();
  glBegin(GL_QUADS);
          glColor3f(1.0,0.5,0.0);                              // Set The Color To Orange
          glVertex3f( 1.0,-1.0, 1.0);                  // Top Right Of The Quad (Bottom)
          glVertex3f(-1.0,-1.0, 1.0);                  // Top Left Of The Quad (Bottom)
          glVertex3f(-1.0,-1.0,-1.0);                  // Bottom Left Of The Quad (Bottom)
          glVertex3f( 1.0,-1.0,-1.0);                  // Bottom Right Of The Quad (Bottom)
  glEnd();
  glBegin(GL_QUADS);
          glColor3f(1.0,0.0,0.0);                              // Set The Color To Red
          glVertex3f( 1.0, 1.0, 1.0);                  // Top Right Of The Quad (Front)
          glVertex3f(-1.0, 1.0, 1.0);                  // Top Left Of The Quad (Front)
          glVertex3f(-1.0,-1.0, 1.0);                  // Bottom Left Of The Quad (Front)
          glVertex3f( 1.0,-1.0, 1.0);                  // Bottom Right Of The Quad (Front)
  glEnd();
  glBegin(GL_QUADS);
          glColor3f(1.0,1.0,0.0);                              // Set The Color To Yellow
          glVertex3f( 1.0,-1.0,-1.0);                  // Bottom Left Of The Quad (Back)
          glVertex3f(-1.0,-1.0,-1.0);                  // Bottom Right Of The Quad (Back)
          glVertex3f(-1.0, 1.0,-1.0);                  // Top Right Of The Quad (Back)
          glVertex3f( 1.0, 1.0,-1.0);                  // Top Left Of The Quad (Back)
  glEnd();
  glBegin(GL_QUADS);
          glColor3f(0.0,0.0,1.0);                              // Set The Color To Blue
          glVertex3f(-1.0, 1.0, 1.0);                  // Top Right Of The Quad (Left)
          glVertex3f(-1.0, 1.0,-1.0);                  // Top Left Of The Quad (Left)
          glVertex3f(-1.0,-1.0,-1.0);                  // Bottom Left Of The Quad (Left)
          glVertex3f(-1.0,-1.0, 1.0);                  // Bottom Right Of The Quad (Left)
  glEnd();
  glBegin(GL_QUADS);
          glColor3f(1.0,0.0,1.0);                              // Set The Color To Violet
          glVertex3f( 1.0, 1.0,-1.0);                  // Top Right Of The Quad (Right)
          glVertex3f( 1.0, 1.0, 1.0);                  // Top Left Of The Quad (Right)
          glVertex3f( 1.0,-1.0, 1.0);                  // Bottom Left Of The Quad (Right)
          glVertex3f( 1.0,-1.0,-1.0);                  // Bottom Right Of The Quad (Right)
  glEnd();


  cube_rotation += 5.15 * Speed;

end;

// функция  GetBitmap по замыслу  должна копировать контекст OGL  на текстуру...
function GetBitmap(width,height: Integer): TBitmap;
var tbuf,buf,Pline: Pointer;   i,h,w: Integer;    waserror: boolean;
  texture : GLuint;
begin
    w := width;   h := height;

waserror := TRUE;    buf := nil;
  Try
  Result := TBitmap.Create;
  Result.PixelFormat := pf24bit;
  Result.Width := width;    Result.Height := height;
  GetMem(buf, w*h*3);
  glPixelStorei(GL_PACK_ALIGNMENT, 1);
  glBindTexture(GL_TEXTURE_2D, texture);
  glGetTexImage(GL_TEXTURE_2D, 0, GL_Rgb, GL_UNSIGNED_BYTE, buf);
  tbuf := buf;
  Result.BeginUpdate;
     For i := h-1 downto 0 do begin
     Pline := Result.ScanLine[i];
     Move(tbuf^, Pline^, w*3);
     Inc(NativeInt(tbuf), w*3);
     end;
  Result.EndUpdate;
     waserror := FALSE;
  finally
  If waserror then FreeAndNil(Result);
  FreeMemory(buf);
  end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var  x, y: Integer;
begin
  // В цикле рисуется так называемый шум :)
  ScrBitmap.BeginUpdate;

  for y := 0 to Sy - 1 do
    for x := 0 to Sx*3 - 1 do
      TDibPoints(ScrBitmap.ScanLine[y]^ )[x] :=Random(256);
  Self.ScrBitmap.endUpdate;

  Image1.Picture.Bitmap.Canvas.Draw(0, 0, ScrBitmap);  //запись в имидж
end;

procedure TForm1.Button2Click(Sender: TObject);
var
b:TBitMap;
begin

// "Чистый тест" ! выводит на не большой  OpenGLControl в правом нижнем углу окна .
   MyPaint01(OpenGLControl1.Width,OpenGLControl1.Height);
OpenGLControl1.SwapBuffers;
//---------------------------------------------------------------------------------

// GetBitmap Мысль хорошая но .. не работает!
  B:=GetBitmap(OpenGLControl1.Width, OpenGLControl1.Height);
  image1.Picture.Bitmap.Canvas.Draw(0,0,B);
  b.Free;
end;
// : Аналог "Способа Maxizar-ра" - "рисует" на "фоновом" битмапе.
procedure TForm1.Button3Click(Sender: TObject);
var CanvasHandle,hrc:HDC;
   pfd: TPixelFormatDescriptor;
  nPixelFormat: Integer;
FormatIndex: Integer;
lFDC: HDC;
  ps : TPaintStruct;
  b:TBitMap;
begin

lFDC := ScrBitmap.Canvas.Handle;
FillChar(PFD, SizeOf(PFD), 0);
  With PFD do begin
  nSize := SizeOf(PFD);   nVersion := 1;
  dwFlags := pfd_Draw_to_Bitmap or pfd_Support_OpenGL
  or    PFD_GENERIC_ACCELERATED;
  iPixelType := pfd_Type_RGBA;
  cColorBits := 24;    cDepthBits := 32;
  iLayerType := pfd_Main_Plane;
  end;

FormatIndex := ChoosePixelFormat(lFDC, @PFD);
SetPixelFormat(lFDC, FormatIndex, @PFD);
HRC := wglCreateContext(lFDC);
wglMakeCurrent(lFDC, HRC);
// 2D....
If not CheckBox1.Checked then
  begin
   glLineWidth(9); // размер точек
   glColor3ub(255,0,0); // цвет примитивов
   glBegin(GL_LINES); // открываем командную скобку,
   glVertex2f(-1,-1);
   glVertex2f(1,1);
   glEnd; //Закрываем командную скобку GL
  end
    else //3D...
      MyPaint01(ScrBitmap.Width,ScrBitmap.Height);

   glFlush;
   Image1.Picture.Bitmap.Canvas.Draw(0, 0, ScrBitmap);
   wglDeleteContext(hrc);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ScrBitmap:=TBitmap.Create;
  Sx:=1000;Sy:=1000; Speed:=2;
  ScrBitmap.PixelFormat:=pf24bit;
  ScrBitmap.SetSize(1000,1000);
  ScrBitmap.BeginUpdate;
  ZeroMemory(ScrBitmap.ScanLine[0], (SX*3) * SY  );
  ScrBitmap.EndUpdate;
  Image1.Canvas.Draw(0, 0, ScrBitmap);
  Application.Title := Caption;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteBitmap();
end;


procedure TForm1.DeleteBitmap;
begin
  // Удаление DIB
  ScrBitmap.FreeImage();
  ScrBitmap.Destroy;
end;

end.



GLForm.lfm ( Для ленивых )

Код: Выделить всё

object Form1: TForm1
  Left = 487
  Height = 305
  Top = 125
  Width = 414
  Caption = 'Визуализатор'
  ClientHeight = 305
  ClientWidth = 414
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  LCLVersion = '1.8.0.6'
  object Image1: TImage
    Left = 0
    Height = 305
    Top = 0
    Width = 414
    Align = alClient
    Stretch = True
  end
  object Button1: TButton
    Left = 40
    Height = 25
    Top = 272
    Width = 75
    Caption = 'Button1'
    OnClick = Button1Click
    TabOrder = 0
  end
  object Button2: TButton
    Left = 128
    Height = 25
    Top = 272
    Width = 75
    Caption = 'Button2'
    OnClick = Button2Click
    TabOrder = 1
  end
  object OpenGLControl1: TOpenGLControl
    Left = 256
    Height = 117
    Top = 144
    Width = 149
  end
  object Button3: TButton
    Left = 208
    Height = 25
    Top = 272
    Width = 75
    Caption = 'Button3'
    OnClick = Button3Click
    TabOrder = 3
  end
  object CheckBox1: TCheckBox
    Left = 311
    Height = 19
    Top = 280
    Width = 78
    Caption = 'CheckBox1'
    TabOrder = 4
  end
end