nPOINT=step*10+1;
nPOLYGON=step*10+step;
col1=255+255*$100+204*$10000; //цвет стенок(полигонов) вазы
col2=209+154*$100+65*$10000; //цвет дна вазы
var
Form1:TForm1;
Buf,Blinc_Buf:TBitMap;
polygons:array[1..nPolygon] of Tpolygon;
w,v1:array[1..nPOINT] of T3DPoint;//мировые (world),видовые (view) координаты вершин
v:array[1..nPOINT] of TPoint;//экранные (screen) координаты вершин
S:array[1..nPOLYGON] of extended;
n:array[1..nPOLYGON] of T3DPoint; //массив нормалей
teta,phi,d,ro,r:real;
implementation
{$R *.dfm}
function tone(clr:TColor;nz:extended):TColor; //плоскость цвета
begin
tone:=rgb(round(nz*GetRValue(clr)),
round(nz*GetGValue(clr)),
round(nz*GetBValue(clr)))
end;
procedure ViewTransformation;
var i: integer;
begin
for i:=1 to nPOINT Do
begin
v1[i].x:=Round(w[i].x*(-sin(teta))+w[i].y*(cos(teta)));
v1[i].y:=Round(w[i].x*(-cos(phi)*cos(teta))-w[i].y*(cos(phi)*sin(teta))+
w[i].z*( sin(phi)));
v1[i].z:=Round(w[i].x*(-sin(phi)*cos(teta))-w[i].y*( sin(phi)*sin(teta))-
w[i].z*(cos(phi)))+ro;
v[i].x:=Round(Form1.ClientWidth div 2+v1[i].x );
v[i].y:=Round(Form1.ClientHeight div 2+v1[i].y);
end;
end;
procedure Sort;
var
i:integer;
begin
for i:=1 to nPOLYGON do
begin
s[i]:=(v1[polygons[i].a].z+v1[polygons[i].b].z+v1[polygons[i].c].z)/3;
//координаты вектора нормали
n[i].x:=v1[polygons[i].a].y*(v1[polygons[i].b].z-v1[polygons[i].c].z)+
v1[polygons[i].b].y*(v1[polygons[i].c].z-v1[polygons[i].a].z)+
v1[polygons[i].c].y*(v1[polygons[i].a].z-v1[polygons[i].b].z);
n[i].y:=v1[polygons[i].a].z*(v1[polygons[i].b].x-v1[polygons[i].c].x)+
v1[polygons[i].b].z*(v1[polygons[i].c].x-v1[polygons[i].a].x)+
v1[polygons[i].c].z*(v1[polygons[i].a].x-v1[polygons[i].b].x);
n[i].z:=v1[polygons[i].a].x*(v1[polygons[i].b].y-v1[polygons[i].c].y)+
v1[polygons[i].b].x*(v1[polygons[i].c].y-v1[polygons[i].a].y)+
v1[polygons[i].c].x*(v1[polygons[i].a].y-v1[polygons[i].b].y);
if (sqrt(sqr(n[i].x)+sqr(n[i].y)+sqr(n[i].z)))<>0 then
n[i].z:=n[i].z/(sqrt(sqr(n[i].x)+sqr(n[i].y)+sqr(n[i].z)))
else n[i].z:=0;
end;
end;
procedure Draw;
var
j,i1,i:integer;
f: real;
begin
Sort;
f:=0;
buf.Canvas.Draw(0,0,blinc_buf); //рисуемвосновномбуферефон
for i1:=1 to nPOLYGON do
begin
//Опред.невидимости грани (слегка затеняем внутреннюю поверхность)
if (n[i1].z>0) then n[i1].z:=n[i1].z*0.60;
end;
for i1:=1 to nPOLYGON do
begin
for i := 1 to nPOLYGON do
if s[i]>f then begin j:=i;f:=s[i];end;
with polygons[j] do
begin
Buf.Canvas.Brush.Color:=tone(clr,ABS(n[j].z)); //цвет полигона
Buf.Canvas.Pen.Color:=tone(clr,ABS(n[j].z*0.96));//цвет границ полигонов
Buf.Canvas.Polygon([v[A],v[B],v[C],v[D]]); //прорисовка полигона
end;
s[j]:=0;
f:=0;
end;
Form1.Canvas.Draw(0,0,buf); //прорисовываем буфер на экране(форме)
end;
procedure TForm1.KeyDown(Sender:TObject;var Key:Word;Shift:TShiftState);
begin
CASE KEY of
VK_UP: phi:=phi+pi*0.05;
VK_DOWN: phi:=phi-pi*0.05;
VK_LEFT: teta:=teta+pi*0.03;
VK_RIGHT: teta:=teta-pi*0.03;
end;
ViewTransformation;
Draw;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
B,L,H,nn:integer;
dL:Real;
const
Rz:array[0..9] of integer = (50,75,90,94,88,74,54,42,40,46);//радиусы параллелей
begin
H:=250; // высота вазы
d:=200; //масштаб
ro:=500; //перспектива
teta:=pi/9; //угол поворота
phi:=pi*4/3; //угол поворота
// вершинывазы
for B:=0 to 9 do
begin
for L:=0 to step-1 do
begin
dL:=L*Pi*(360/step)/180;
w[B*step+L+1].x:=Rz[B]*sin(dL); //Вычисление мировых координат
w[B*step+L+1].y:=Rz[B]*cos(dL);
w[B*step+L+1].z:=H/10*B-H/2;
end;
end;
// полигоны вазы
nn:=1;
for B:=1 to 9 do
begin
for L:=0 to step-2 do
begin
polygons[nn].A:=(B-1)*step+L+1;
polygons[nn].B:=(B-1)*step+L+2;
polygons[nn].C:=B*step+L+2;
polygons[nn].D:=B*step+L+1;
polygons[nn].clr:=col1;
nn:=nn+1;
end;
polygons[nn].A:=B*step;
polygons[nn].B:=(B-1)*step+1;
polygons[nn].C:=B*step+1;
polygons[nn].D:=(B+1)*step;
polygons[nn].clr:=col1;
nn:=nn+1;
end;
// вершина дна вазы
w[nPOINT].x:=0;w[nPOINT].y:=0;w[nPOINT].z:=-H/2;
// полигоны дна вазы
for L:=0 to step-2 do
begin
polygons[L+nPOINT].A:=L+2;
polygons[L+nPOINT].B:=L+1;
polygons[L+nPOINT].C:=nPOINT;
polygons[L+nPOINT].D:=nPOINT;
polygons[L+nPOINT].clr:=col2;
end;
polygons[nPOLYGON].A:=1;
polygons[nPOLYGON].B:=step;
polygons[nPOLYGON].C:=nPOINT;
polygons[nPOLYGON].D:=nPOINT;
polygons[nPOLYGON].clr:=col2;
// буфер
buf:=TBitmap.Create;
buf.Width:=Form1.ClientWidth;
buf.Height:=Form1.ClientHeight;
// фон
blinc_buf:=TBitmap.Create;
blinc_buf.Width:=Form1.ClientWidth;
blinc_buf.Height:= Form1.ClientHeight;
blinc_buf.Canvas.Rectangle(0,0,Form1.ClientWidth,Form1.ClientHeight);
blinc_buf.LoadFromFile('./background.bmp');
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
// ViewTransformation;
// Draw;
end;
end.