unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,opengl;
type
Tbitmapheader = array[0..53] of byte;
TRGB = record b,g,r:byte; end;
TRGBA = record r,g,b,a:byte;end;
TRGBArray=array[0..16384] of TRGB;
TRGBAArray=array[0..16384] of TRGBA;
PRGBAArray =^TRGBAArray;
GLArr=array[0..3] of GLFloat;
TForm1 = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure okpok(Sender: TObject);
procedure UP(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
end;
var
Form1: TForm1;
Wx,Wy,rx,ry:real;
rotate:boolean;
RGB:TRGBArray;
textures:array[1..4] of PRGBAArray=(nil,nil,nil,nil);
tex:PRGBAArray;
s_coeffs:array[0..3] of glfloat=(0.5,0.5,0.5,0.5);
t_coeffs:array[0..3] of glfloat=(0.5,0.5,0.5,0.5);
implementation
{$R *.dfm}
function LoadTexture(fname:string;alpha:integer):integer;
var
F:file of byte;
header:TBitmapHeader;
j,i,RGBsize:integer;
begin
assign(f,fname);
reset(f);
RGBSize:=FileSize(f)-54;
for j:=1 to 4 do
if textures[j]=nil
then break;
new(tex);
textures[j]:=tex;
fillchar(header,54,0);
Blockread(f,Header,54);
Blockread(f,RGB,RGBsize);
close(f);
for i:=0 to rgbsize div 3 -1 do
begin
tex[i].r:=RGB[i].r;
tex[i].g:=RGB[i].g;
tex[i].b:=RGB[i].b;
tex[i].a:=alpha;
end;
glpixelstorei(gl_unpack_alignment,4);
result:=j;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
wX:=X;
wY:=Y;
rotate:=true;
end;
procedure SelectTexture(texture: Integer; map,genmode,FilterMode:
GLint; Xmult,Zmult: array of GLFloat);
var
AutoGenModeX:GLint;
AutoGenModeZ:GLint;
WrapSMode:Glint;
WrapTMode:Glint;
MagFilter:Glint;
MinFilter:Glint;
EnvironmentMode:GLint;
begin
WrapSmode:=gl_repeat;
WrapTmode:=gl_repeat;
MagFilter:=FilterMode;
MinFilter:=FilterMode;
AutoGenModeX:=map;
AutoGenModeZ:=map;
EnvironmentMode:=GL_decal;
gltexgeni (GL_s,gl_texture_gen_mode,AutoGenModeX);
gltexgenfv(GL_s,genmode,addr(Xmult));
gltexgeni (GL_t,gl_texture_gen_mode,AutoGenModeZ);
gltexgenfv(GL_t,genmode,addr(Zmult));
gltexparameteri(gl_texture_2d,gl_texture_wrap_s,WrapSmode);
gltexparameteri(gl_texture_2d,gl_texture_wrap_t,WrapTmode);
gltexparameteri(gl_texture_2d,gl_texture_mag_filter,MagFilter);
gltexparameteri(gl_texture_2d,gl_texture_min_filter,MinFilter);
gltexEnvi(gl_texture_env,gl_texture_env_mode,EnvironmentMode);
glTexImage2D(gl_texture_2d,0,4,128,128,0,GL_RGBA,GL_UNSIGNED_BYTE,textures[texture]);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
X,Y: Integer);
begin
if rotate then
begin
rX:=rX+(X-wX)/2;
rY:=rY+(Y-wY)/2;
wX:=X;
wY:=Y;
InvalidateRect(Handle,nil,false);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
pfd:TPixelFormatDescriptor;
nPixelFormat: Integer;
begin
FillChar(pfd, sizeof(pfd), 0);
nPixelFormat:=ChoosePixelFormat(Canvas.Handle, @pfd);
SetPixelFormat(Canvas.Handle, nPixelFormat, @pfd);
end;
procedure TForm1.okpok(Sender: TObject);
const
knots : Array [0..7] of GLFloat = (0.0, 0.0, 0.0, 0.0, 1.0, 1.0, 1.0, 1.0);
points2 : Array [0..3, 0..3, 0..2] of GLFloat =
( (
(0.1, 0.0, 0),
(0.2, 0.0, 0),
(0.3, 0, 0),
(0.4, 0, 0)),
(
(0.1, 0.1, 0),
(0.2, 0.1, 0),
(0.3, 0.1, 0),
(0.4, 0.1,0)),
(
(0.1, 0.2, 0),
(0.2, 0.2, 0),
(0.3, 0.2, 0),
(0.4,0.2, 0)),
(
(0.1, -0.0, 0),
(-0.1, 0.36, 0),
(0.3, 0.2, 0),
(0.4, 0.0, 0))
);
Black: array[0..3] of GLFloat=(0,0,0,1);
var
hrc:HGLRC;
x,y:real;
Nurb: gluNurbsObj;
textur:integer;
begin
hrc:=wglCreateContext(Canvas.Handle);
wglMakeCurrent(Canvas.Handle,hrc);
glClearColor(0.9,0.9,0.9,1.0);
glClear(GL_COLOR_BUFFER_BIT);
glRotatef(rX,0,1,0);
glRotatef(rY,1,0,0);
Nurb:=gluNewNurbsRenderer;
gluNurbsProperty (Nurb, GLU_SAMPLING_TOLERANCE, 25.0);
gluBeginSurface (Nurb);
glEnable(GL_TEXTURE_2D);
glenable(gl_texture_gen_s);
glenable(gl_texture_gen_t);
textur:=loadtexture('D:\1.bmp',1);
selecttexture(Textur, gl_eye_linear, gl_texture_gen_mode, gl_linear,s_coeffs,t_coeffs);
gltexenvf(gl_texture_env,gl_texture_env_mode,gl_Replace);
gluNurbsSurface (Nurb,8, @knots,8, @knots,4 * 3,3,@points2,4, 4,GL_MAP2_VERTEX_3);
gluEndSurface (Nurb);
GLRotatef(45,0,0,1);
GLTranslatef(0,0,0);
gluEndSurface(Nurb);
gluDeleteNurbsRenderer(Nurb);
wglMakeCurrent (0,0);
wglDeleteContext(hrc);
end;
procedure TForm1.UP(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
rotate:=false;
end;
end.
07.10.2010, 00:21
Текстурирование Nurb поверхности
Линейный вид
