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