Упражнение.

ИЗ файла поместить изображение 128*128 в Image1, подготовить текстуру на сферу, при щелчке по кнопке Button1 заставить вращаться.
Используются дисплейные списки
unit Unit1;
interface
uses openGL, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
dc: hdc; hrc: hGLRC;
Используются процедуры:
Procedure CreateTexture;
Procedure SetDcPixelFormat (dc: hdc);
end;
var
Form1: TForm1;
bmp:tbitmap;
implementation
{$R *.dfm}
Procedure CreateTexture;
var i, k: integer; c: integer;
Im: array [0..127, 0..127, 0..2] of gluByte;
begin
for i:=0 to 127 do
for k:=0 to 127 do
begin
c:= Bmp.Canvas.Pixels [i,k];
im[i, k][0]:=GetRValue (c); im[i, k][1]:=GetGValue (c); im[i, k][2]:=GetBValue (c); end;
GLTexImage2D (gl_texture_2d, 0, GL_RGB, 128, 128, 0, GL_RGB, GL_Unsigned_Byte, @im);
end;
//---------------------------------------
Procedure SetDcPixelFormat (dc: hdc);
var
i: integer;
pfd: TpixelFormatDescriptor;
begin
fillChar (pfd, SizeOf (pfd), 0);
pfd.dwFlags:=pfd_Draw_To_window or pfd_Support_OpenGL or pfd_DoubleBuffer;
i:=ChoosePixelFormat (dc, @pfd); setPixelFormat (dc, i, @pfd);
end;
//---------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
quadric: GLUquadricObj;
const
LightPos0: array [0..3] of GLFloat = (-1, 0, -1, 1);
begin
bmp:=tbitmap.create;
bmp.loadfromfile('bitmap.bmp');
dc:=GetDc (handle);
setDCPixelFormat (dc);
hrc:=wglCreateContext (dc); КОНТЕКСТ
wglMakeCurrent (dc, hrc);
glenable (GL_lighting); //err
glenable (GL_light0); СВЕТ
gllightfv(GL_Light0, GL_position, @LightPos0);
glTexParameteri (gl_texture_2d, gl_texture_min_filter, gl_nearest);
glTexParameteri (gl_texture_2d, gl_texture_mag_filter, gl_nearest);
glEnable (GL_texture_2D);
CreateTexture; //'tekstшe СОЗДАНИЕ ТЕКСТУРЫ
quadric:= GluNewQuadric;
gluQuadricTexture (quadric, true);
gLNewList (1, GL_Compile); //создание списка
gluSphere (quadric, 1.0, 50, 50); // [s'fie] СФЕРА С ТЕКСТУРОЙ- ДИСП.СПИСОК
glEndList;
glEnable (gl_depth_test); //если убрать, то видно лишь верхнее полушарие
glViewPort (100, 80, ClientWidth div 2, ClientHeight div 2);
end;
//----------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
repeat
glClear (gl_Color_Buffer_bit or gl_Depth_Buffer_bit); СТЕРЕТЬ
glRotatef (1, 0, 0, 1); ПОВЕРНУТЬ СИСТ.КООРД.
glCallList (1); ВЫВЕСТИ СФЕРУ С ТЕКСТУРОЙ
swapBuffers (dc); НА ЭКРАН
until false;
end;
end.