5. Описание возможностей программы.
Программа Varnok позволяет демонстрировать трёхмерные сцены из невыпуклых многогранников и производить их преобразования. Представлены следующие режимы изображения:
Проволочный (рис. №5)
Контурный (рис. №6)
Полутоновый (рис. №7)
рис.4 “проволочный режим”
рис.4 “контурный режим”
рис.5 “полутоновый режим”
6. Интерфейс.
6.1. Главное окно.
В главном окне демонстрируются 3D модели. Здесь же можно производить их преобразования(рис.6).
Рис.6
6.2 Меню
Файл :
Открыть – открывает новую модель созданную в 3D Studio Max (*.asc) или в другом 3D редакторе.
Выход – закрывает программу
Настройки:
Режим изображения – вид отображения модели(проволочный, контурный, полутоновый).
Вращать – вращение модели вокруг осей X, Y и Z.
Двигать – перемещение модели по сям X и Y.
Масштабировать – увеличение и уменьшение модели.
Сменить цвет фона – меняет цвет фона главного окна.
Сменить цвет фигуры – меняет цвет фигуры.
7. Листинг
Unit 1:
procedure Line(p1,p2 : TPoint3d); //отрисовка линии
procedure SetPoint(X, Y, Color: Longint); //установка точки
procedure Line(p1,p2 : TPoint3d);
begin
Form1.PaintBox1.Canvas.Pen.Color := objcolor;
Form1.PaintBox1.Canvas.MoveTo(p1^.x2d,p1^.y2d);
Form1.PaintBox1.Canvas.LineTo(p2^.x2d,p2^.y2d);
end;
procedure SetPoint(X, Y, Color: Longint);
begin
if ( (X>=0) and (X<SWidth) and (Y>=0) and (Y<SHeight) ) then
Form1.PaintBox1.Canvas.Pixels[x,y] := Color;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
foncolor:=RGB(255,255,255); //задаем исходно белый цвет фона
objcolor:=RGB(0,0,0); //и черный - объекта
ClearScreen(); //очищаем экран
end;
procedure TForm1.ClearScreen();
begin
Form1.PaintBox1.Canvas.Pen.Color := foncolor;
Form1.PaintBox1.Canvas.Brush.Color:=foncolor;
Form1.PaintBox1.Canvas.Brush.Style:=bsSolid;
Form1.PaintBox1.Canvas.Rectangle(0,0,Width,Height);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
SWidth := PaintBox1.Width;
SHeight := PaintBox1.Height;
MidX := Round(SWidth/2);
MidY := Round(SHeight/2);
ClearScreen();
if (Figure1<>nil) then Figure1.ShowFigure; //вызываем метод отрисовки фигуры
end;
procedure TForm1.N2Click(Sender: TObject);
begin //обработчик переключения на проволочный режим
if (N2.Checked=false) then
begin
N3.Checked := false;
N6.Checked := false;
N2.Checked := true;
Figure1.shading:=1; //устанавливаем флаг проволочного режима
PaintBox1Paint(Sender);
end;
end;
procedure TForm1.N3Click(Sender: TObject);
begin //обработчик переключения на контурный режим
if (N3.Checked=false) then
begin
N2.Checked := false;
N6.Checked := false;
N3.Checked := true;
Figure1.shading:=2; //устанавливаем флаг
PaintBox1Paint(Sender);
end;
end;
procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.OpenAscFile1Click(Sender: TObject);
var //процедура открытия ASCII файла
s:string;
ss:AnsiString;
begin
setlength(ss,1000);
GetCurrentDirectory(1000,PChar(ss));
OpenDialog1.InitialDir:=ss; //начальный каталог при выборе файла - текущий
if (OpenDialog1.Execute=true) then
begin
N2.Checked:=true;
N3.Checked:=false;
s:=OpenDialog1.FileName;
if (Figure1<>nil) then Figure1.FigureDestroy; //уничтожаем старую копию фигуры если была
Figure1 :=Figure.FigureCreate(s); //и создаем новую фигуру
Options1.Enabled:=true; // включаем возможность регулировки настроек
PaintBox1Paint(Sender);
end;
end;
Unit 2:
procedure Normalize (V: TPoint3d); //приведение к единичному вектору
var
length: extended;
begin length := sqrt((V^.x * V^.x) + (V^.y * V^.y) + (V^.z * V^.z));//общая длина
V^.x := V^.x/length;
V^.y := V^.y/length;
V^.z := V^.z/length;
end;
//---------------------------------------------------------------------------
constructor Figure.FigureCreate(FileName: string); //конструктор класса
begin //FileName - имя загружаемого файла
numPoints := 0; // инициализация переменных
numNormals := 0;
numFaces := 0;
LoadObject(FileName);//вызов метода "загрузка объекта"
end;
destructor Figure.FigureDestroy; //удаление памяти связанной с классом
var
count: Longword;
begin
for count:=0 to (numPoints-1) do //все точки, грани, нормали
dispose(points[count]);
points := nil; //обнуляем сами массивы указателей
for count:=0 to (numNormals-1) do
dispose(normals[count]);
normals := nil;
for count:=0 to (numFaces-1) do
dispose(polys[count]);
polys := nil;
end;
procedure Figure.SetMidPoint; //расчет координат точки центра объекта
var
count: Integer;
tmpX,tmpY,tmpZ: extended;
begin
tmpX:=0;
tmpY:=0;
tmpZ:=0;
for count:=0 to (numPoints-1) do
begin
tmpX := tmpX + points[count]^.x; //суммируем все координаты X Y Z
tmpY := tmpY + points[count]^.y;
tmpZ := tmpZ + points[count]^.z;
end;
tmpX := tmpX/numPoints; //и делим их на общее кол-во точек
tmpY := tmpY/numPoints;
tmpZ := tmpZ/numPoints;
midpoint.x := tmpX; //получаем точку центра объекта
midpoint.y := tmpY;
midpoint.z := tmpZ;
end;
procedure Figure.CalcNormal(N: Longword); //расчет нормали (при загрузке)
var //точки грани всегда заданы по часовой стрелке поэтому нормаль всегда выходит ИЗ объекта
Vector1: array [0..2] of extended;//вспомогательные переменные
Vector2: array [0..2] of extended;
nx,ny,nz,l: extended;
begin
Vector1[0]:= polys[N]^.B^.x - polys[N]^.A^.x;// находим 2 вектора в плоскости
Vector2[0]:= polys[N]^.C^.x - polys[N]^.A^.x;// грани
Vector1[1]:= polys[N]^.B^.y - polys[N]^.A^.y;
Vector2[1]:= polys[N]^.C^.y - polys[N]^.A^.y;
Vector1[2]:= polys[N]^.B^.z - polys[N]^.A^.z;
Vector2[2]:= polys[N]^.C^.z - polys[N]^.A^.z;
nx := Vector1[2]*Vector2[1] - Vector1[1]*Vector2[2];//находим векторное произведение
ny := Vector1[0]*Vector2[2] - Vector1[2]*Vector2[0];//этих векторов
nz := Vector1[1]*Vector2[0] - Vector1[0]*Vector2[1];//это и есть нормаль к грани
l:=sqrt((nx * nx) + (ny * ny) + (nz * nz));//нормализуем ее
if (l<>0) then
begin
nx := nx/l;
ny := ny/l;
nz := nz/l;
end;
new(normals[N]); //добавляем в список нормалей
normals[N]^.x := nx;
normals[N]^.y := ny;
normals[N]^.z := nz;
polys[N]^.normal := normals[N];
end;
procedure Figure.LoadObject(FileName: string); //метод "загрузка объекта"
var
f: Text; //открываемый текстовый файл
str: string;
Znach :string;
Vertices, Faces: Longword; //общее кол-во вершин и граней
count, A, B, C: Longword;
X, Y, Z: extended;
Code: Integer;
n1,n2: byte;
begin
Assign(f,FileName);
Reset(f);
while (not EOF(f)) do
begin
Readln(f,str);
if(Pos('Tri-mesh',str)<>0) then //ищем эту строку (она означает что сейчас
begin // будет описание фигуры)
n1:=21;
n2:=Pos('Faces',str); //ищем положение этой строки
n2:=n2-5; //n1 и n2 положения в строке числа
Znach:=Copy(str,n1,n2-n1);//выделяем это число из строки
Val(Znach,Vertices,Code);//преобразуем в числовой формат
n1:=n2+5+7;
n2:=Length(str)+1;
Znach:=Copy(str,n1,n2-n1);
Val(Znach,Faces,Code);
numPoints := Vertices;
numNormals := Faces;
numFaces := Faces;
SetLength(points,Vertices); //устанавливаем массивы указателей
SetLength(normals,Faces); // в реальные значения
SetLength(polys,Faces);
Readln(f,str); //пропускаем "Vertex list:"
if (Pos('Mapped',str)<>0) then Readln(f,str);//текстурные коорд не нужны
for count:=0 to (Vertices-1) do
begin
Readln(f,str);
n1:=Pos('X:',str)+2;
n2:=Pos('Y:',str)-5;
Znach:=Copy(str,n1,n2-n1); //выделяем координату Х
Val(Znach,X,Code);
n1:=Pos('Y:',str)+2;
n2:=Pos('Z:',str)-5;
Znach:=Copy(str,n1,n2-n1); //выделяем координату У
Val(Znach,Y,Code);
n1:=Pos('Z:',str)+2;
if (Pos('U:',str)=0) then
n2:=Length(str)+1
else
n2:=Pos('U:',str)-5;
Znach:=Copy(str,n1,n2-n1); //выделяем координату Z
Val(Znach,Z,Code);
new(points[count]); //выделяем память для точки
points[count]^.x:=X;
points[count]^.y:=Z; //в 3dMax обычно меняют Y c Z
points[count]^.z:=Y;
end;
Readln(f,str); //пропускаем "Face list:"
Readln(f,str);
for count:=0 to (Faces-1) do
begin
while Pos('Face',str)=0 do Readln(f,str);
n1:=Pos('A:',str)+2;
n2:=Pos('B:',str)-1;
Znach:=Copy(str,n1,n2-n1);//выделяем позицию точки А
Val(Znach,A,Code);
n1:=Pos('B:',str)+2;
n2:=Pos('C:',str)-1;
Znach:=Copy(str,n1,n2-n1);//выделяем позицию точки В
Val(Znach,B,Code);
n1:=Pos('C:',str)+2;
n2:=Pos('AB:',str)-1;
Znach:=Copy(str,n1,n2-n1);//выделяем позицию точки С
Val(Znach,C,Code);
new(polys[count]); //выделяем память для грани
polys[count]^.A:=points[A];
polys[count]^.B:=points[B];
polys[count]^.C:=points[C];
CalcNormal(count); //расчет нормали для этой грани
Readln(f,str);
end;
shading:=1; //затенение - проволочное
SetMidPoint; //расчет центра фигуры
break;
end;
end;
Close(f); //закрываем файл
end;
//Вращение относительно точки
procedure Figure.RotateAboutPoint(X, Y, Z, angleX, angleY, angleZ: extended);
var
sinx,cosx,siny,cosy,sinz,cosz: extended;
coordX,coordY,coordZ: extended;
tX,tY,tZ: extended;
count: Longword;
begin
sinx := Sin(angleX * PI / 180.0); //расчет синусов и косинусов углов поворота
cosx := Cos(angleX * PI / 180.0);
siny := Sin(angleY * PI / 180.0);
cosy := Cos(angleY * PI / 180.0);
sinz := Sin(angleZ * PI / 180.0);
cosz := Cos(angleZ * PI / 180.0);
for count:=0 to (numPoints-1) do //вначале поворот всех точек
begin
coordX := points[count]^.x - X; //вычисляем локальные координаты
coordY := points[count]^.y - Y; //(переносим в начало координат
coordZ := points[count]^.z - Z;
tX := (coordX * cosz - coordY * sinz);//ось Z
tY := (coordX * sinz + coordY * cosz);
tZ := coordZ;
coordY := (tY * cosx - tZ * sinx);//ось X
coordZ := (tY * sinx + tZ * cosx);
tZ := coordZ;
coordX := (tZ * siny + tX * cosy);//ось Y
coordZ := (tZ * cosy - tX * siny);
points[count]^.x := coordX + X;//преобразуем локальные координаты в мировые
points[count]^.y := coordY + Y;
points[count]^.z := coordZ + Z;
end;
for count:=0 to (numNormals-1) do //затем поворот всех нормалей
begin
coordX := normals[count]^.x;
coordY := normals[count]^.y;
coordZ := normals[count]^.z;
tX := (coordX * cosz - coordY * sinz);//ось Z
tY := (coordX * sinz + coordY * cosz);
tZ := coordZ;
coordY := (tY * cosx - tZ * sinx);//ось X
coordZ := (tY * sinx + tZ * cosx);
tZ := coordZ;
coordX := (tZ * siny + tX * cosy);//ось Y
coordZ := (tZ * cosy - tX * siny);
normals[count]^.x := coordX;
normals[count]^.y := coordY;
normals[count]^.z := coordZ;
end;
end;
//вращать относительно начала координат
procedure Figure.RotateWorldCoord(angleX, angleY, angleZ: extended);
begin
RotateAboutPoint(0,0,0,angleX,angleY,angleZ);
end;
//перенос тела по осям
procedure Figure.Translate(dX, dY, dZ: extended);
var
count: Longword;
begin
for count:=0 to (numPoints-1) do
begin
points[count]^.x:=points[count]^.x+dX;
points[count]^.y:=points[count]^.y+dY;
points[count]^.z:=points[count]^.z+dZ;
end;
end;
//масштабирование тела
procedure Figure.Scale(sX, sY, sZ: extended);
var
count: Longword;
coordX,coordY,coordZ: extended;
begin
for count:=0 to (numPoints-1) do
begin
coordX := points[count]^.x - midpoint.x; //переносим в начало координат
coordY := points[count]^.y - midpoint.y;
coordZ := points[count]^.z - midpoint.z;
coordX := coordX*sX; //масштабируем
coordY := coordY*sY;
coordZ := coordZ*sZ;
points[count]^.x := coordX + midpoint.x; //теперь обратно в мировые координаты
points[count]^.y := coordY + midpoint.y;
points[count]^.z := coordZ + midpoint.z;
end;
end;
//преобразование координат на плоскость (в экранные)
procedure Figure.TransformToScreen;
var
count: Longword;
begin
for count:=0 to (numPoints-1) do
begin
points[count]^.x2d := Round(points[count]^.x) + MidX; //центруем по Х
points[count]^.y2d := MidY - Round(points[count]^.y); //теперь по У
end; //ось У идет вверх поэтому вычитаем
end;
//метод отображающий фигуру
procedure Figure.ShowFigure;
begin
TransformToScreen();
case shading of
1: Wire;
2: Varnok;
3: Varnok;
end;
end;
procedure Figure.Wire; //рисует проволочный вид
var
count : Longword;
begin
for count:=0 to (numFaces-1) do
begin
Line(polys[count]^.A,polys[count]^.B);
Line(polys[count]^.B,polys[count]^.C);
Line(polys[count]^.C,polys[count]^.A);
end;
end;
////////////////////////////////////////////////////////////////////////////////
// Набор структур и процедур для рисования методом Варнока
type //структура для занесения данных об обрабатываемом окне
Window = record
x,y,size:Longint; //координаты левой нижней точки и длина окна
end;
var
Stack: array of ^Window; //массив для занесения окон в стек
Counter: Longword=0; //счетчик кол-ва окон в стеке
Xmin: array of Longint; //массивы координат прямоугольных оболочек граней
Xmax: array of Longint;
Ymin: array of Longint;
Ymax: array of Longint;
Colors: array of LongWord;
//процедура заталкивания окна в стек
procedure Push(X,Y,SIZE: Longword);
begin
SetLength(Stack,Counter+1); //устанавливаем длину стека на 1-цу больше
new(Stack[Counter]); //и добавляем следующее окно
Stack[Counter]^.x:=X;
Stack[Counter]^.y:=Y;
Stack[Counter]^.size:=SIZE;
inc(Counter);
end;
//процедура извлечения окна из стека
procedure Pop(var X: Longint;var Y: Longint;var SIZE: Longint);
begin
if (Counter-1)<0 then exit;
X:=Stack[Counter-1]^.x;
Y:=Stack[Counter-1]^.y;
SIZE:=Stack[Counter-1]^.size;
dispose(Stack[Counter-1]);
SetLength(Stack,Counter-1); //уменьшаем стек на 1-цу
dec(Counter);
end;
//тест прямоугольных оболочек граней на попадание в окно
function simple_triangle_Test(N,X,Y,SIZE: Longint):boolean;
var
Xleft,Xright,Ybottom,Ytop: Longint;
begin
Xleft := X;
Xright := X+SIZE-1;
Ytop := Y;
Ybottom := Y+SIZE-1;
if (Xmin[N]>Xright) then begin simple_triangle_Test:=false; exit; end;
if (Xmax[N]<Xleft) then begin simple_triangle_Test:=false; exit; end;
if (Ymax[N]<Ytop) then begin simple_triangle_Test:=false; exit; end;
if (Ymin[N]>Ybottom) then begin simple_triangle_Test:=false; exit; end;
simple_triangle_Test:=true; //если пересекает окно значит true
end;
//фунция расчета глубины по Z треугольника в точке экрана (Х,У)
function ZDepth(X,Y:Longword; tP:TTriangle):extended;
type
fpoint = record
x,y,z: extended;
end;
var
PX,PY:extended;
p,q: fpoint; //векторы в грани
n: fpoint; //нормаль к грани
cc: extended; //свободный член ур-ния плоскости
A,B,C: TPoint3d;
begin //ур-ние n.x*x+n.y*y+n.z*z-cc=0
Zdepth:=100000000;
A := tP^.A;
B := tP^.B;
C := tP^.C;
p.x := B^.x2d-A^.x2d;//1-й вектор в грани
p.y := B^.y2d-A^.y2d;
p.z := B^.z-A^.z;
q.x := C^.x2d-A^.x2d;//2-й вектор
q.y := C^.y2d-A^.y2d;
q.z := C^.z-A^.z;
n.z := p.x*q.y-p.y*q.x; //их векторное произведение
n.x := p.y*q.z-p.z*q.y;
n.y := -(p.x*q.z-p.z*q.x);
cc := n.x*A^.x2d+n.y*A^.y2d+n.z*A^.z; //свободный член
PX:=X+0.5; //расчет в середине пикселя
PY:=Y+0.5;
if n.z<>0 then
Zdepth := (cc - n.x*PX - n.y*PY)/n.z; //возвращает координату Z в этой точке
end;
// точная проверка того охватывает ли хотя бы одна грань окно размером с пиксел
// и координатами X,Y для контурного режима
function in_Window(X,Y: Longword; P: array of TTriangle; N:Longword):Longint;
var
Zmin: extended; //минимальное Z в этом окне (ближе всех к наблюдателю)
Z: extended;
A,B,C: TPoint3d; //временные точки
AB,BC,CA,AD,BD,CD: Point3d;
D: Point3d;
f1,f2,f3: extended;
s1,s2,s3,s4: extended;
i:Longint;
begin
in_Window:=-1;
Zmin:= 10000000; //заполняем Z максимальным значением т.е. как самый отдаленный
for i:=0 to (N-1) do //цикл проверки по всем граням
begin
A := P[i]^.A;
B := P[i]^.B;
C := P[i]^.C;
if ((A^.y2d = B^.y2d)and(A^.y2d = C^.y2d)) then continue; //если грань видна как линия
if ((A^.x2d = B^.x2d)and(A^.x2d = C^.x2d)) then continue; //то пропускаем ее
D.x := X; //заносим координаты левой верхней координаты пикселя
D.y := Y;
AB.x := B^.x2d - A^.x2d; //рассчитываем векторы сторон грани
AB.y := B^.y2d - A^.y2d;
BC.x := C^.x2d - B^.x2d;
BC.y := C^.y2d - B^.y2d;
CA.x := A^.x2d - C^.x2d;
CA.y := A^.y2d - C^.y2d;
AD.x := D.x - A^.x2d; //рассчит. векторы от вершин грани до верхней координаты пикселя
AD.y := D.y - A^.y2d;
BD.x := D.x - B^.x2d;
BD.y := D.y - B^.y2d;
CD.x := D.x - C^.x2d;
CD.y := D.y - C^.y2d;
f1 := AB.x*AD.y - AD.x*AB.y; //находим векторные произведения векторов сторон грани
f2 := BC.x*BD.y - BD.x*BC.y; //с предыдущими рассчитанными векторами
f3 := CA.x*CD.y - CD.x*CA.y;
if ( (f1<0)and(f2<0)and(f3<0) ) then s1 := -1 else s1 := 1;//если все 3 значения f1,f2,f3
if ((f1=0)and(f2<=0)and(f3<=0)) then s1 := 0; //отрицательны то точка внутри грани
if ((f2=0)and(f1<=0)and(f3<=0)) then s1 := 0; //если одно значение=0 а другие <=0 то
if ((f3=0)and(f1<=0)and(f2<=0)) then s1 := 0; //точка находится на самой грани
//иначе она вне грани
//s1<0 если точка вне грани s1>0 если внутри, и s1=0 если на стороне грани
//далее вычисляем флаги для верхней правой координаты пикселя
//абсолютно также
D.x := X+1;
D.y := Y;
AD.x := D.x - A^.x2d;
AD.y := D.y - A^.y2d;
BD.x := D.x - B^.x2d;
BD.y := D.y - B^.y2d;
CD.x := D.x - C^.x2d;
CD.y := D.y - C^.y2d;
f1 := AB.x*AD.y - AD.x*AB.y;
f2 := BC.x*BD.y - BD.x*BC.y;
f3 := CA.x*CD.y - CD.x*CA.y;
if ( (f1<0)and(f2<0)and(f3<0) ) then s2 := -1 else s2 := 1;
if ((f1=0)and(f2<=0)and(f3<=0)) then s2 := 0;
if ((f2=0)and(f1<=0)and(f3<=0)) then s2 := 0;
if ((f3=0)and(f1<=0)and(f2<=0)) then s2 := 0;
//вычисляем флаги для нижней левой координаты пикселя
//абсолютно также
D.x := X;
D.y := Y+1;
AD.x := D.x - A^.x2d;
AD.y := D.y - A^.y2d;
BD.x := D.x - B^.x2d;
BD.y := D.y - B^.y2d;
CD.x := D.x - C^.x2d;
CD.y := D.y - C^.y2d;
f1 := AB.x*AD.y - AD.x*AB.y;
f2 := BC.x*BD.y - BD.x*BC.y;
f3 := CA.x*CD.y - CD.x*CA.y;
if ( (f1<0)and(f2<0)and(f3<0) ) then s3 := -1 else s3 := 1;
if ((f1=0)and(f2<=0)and(f3<=0)) then s3 := 0;
if ((f2=0)and(f1<=0)and(f3<=0)) then s3 := 0;
if ((f3=0)and(f1<=0)and(f2<=0)) then s3 := 0;
//вычисляем флаги для нижней правой координаты пикселя
//абсолютно также
D.x := X+1;
D.y := Y+1;
AD.x := D.x - A^.x2d;
AD.y := D.y - A^.y2d;
BD.x := D.x - B^.x2d;
BD.y := D.y - B^.y2d;
CD.x := D.x - C^.x2d;
CD.y := D.y - C^.y2d;
f1 := AB.x*AD.y - AD.x*AB.y;
f2 := BC.x*BD.y - BD.x*BC.y;
f3 := CA.x*CD.y - CD.x*CA.y;
if ( (f1<0)and(f2<0)and(f3<0) ) then s4 := -1 else s4 := 1;
if ((f1=0)and(f2<=0)and(f3<=0)) then s4 := 0;
if ((f2=0)and(f1<=0)and(f3<=0)) then s4 := 0;
if ((f3=0)and(f1<=0)and(f2<=0)) then s4 := 0;
//теперь если все вершины пикселя внутри грани то заполняем фоновым цветом
if ( (s1<0)and(s2<0)and(s3<0)and(s4<0) ) then
begin
Z := ZDepth(X,Y,P[i]);
if (Z<Zmin) then //если коорд. Z текущей грани меньше (грань ближе к наблюдателю)
begin //то рисуем пиксель
Zmin := Z;
in_window := foncolor;
end;
continue;
end
else
//если левые верхняя и нижняя вершины пикселя или верхние левая и правая -||- лежат на стороне грани
if ( ((s1=0)and(s3=0))or((s1=0)and(s2=0)) ) then //то закрашиваем цветом фигуры
begin
Z := ZDepth(X,Y,P[i]);
if (Z<Zmin) then
begin
Zmin := Z;
in_window := objcolor;
end;
continue;
end
//если правые верхняя и нижняя вершины пикселя или нижние левая и правая -||- лежат на стороне грани
else //то пропускаем
if ( ((s2=0)and(s4=0))or((s3=0)and(s4=0)) ) then
else //если вершины пикселя лежат по по разные стороны от стороны грани то рисуем цветом фигуры
if ( not((s1>=0)and(s2>=0)and(s3>=0)and(s4>=0)) ) then
begin
Z := ZDepth(X,Y,P[i]);
if (Z<Zmin) then
begin
Zmin := Z;
in_window := objcolor;
end;
continue;
end;
end;
end;
// точная проверка того охватывает ли хотя бы одна грань окно размером с пиксел
// и координатами X,Y для полутонового режима
function in_WindowPainted(X,Y: Longword; P: array of TTriangle; N:Longword):Longint;
var
Zmin: Real; //минимальное Z в этом окне (ближе всех к наблюдателю)
AB,BC,CA: Point3d;
AD,BD,CD: Point3d;
A,B,C: TPoint3d;
Z: Real;
f1,f2,f3: Real;
i:Longword;
begin
in_WindowPainted:=-1;
Zmin:= 10000000; //заполняем Z максимальным значением т.е. как самый отдаленный
for i:=0 to (N-1) do //цикл проверки по всем граням
begin
A := P[i]^.A;
B := P[i]^.B;
C := P[i]^.C;
if ((A^.y2d = B^.y2d)and(A^.y2d = C^.y2d)) then continue; //если грань видна как линия
if ((A^.x2d = B^.x2d)and(A^.x2d = C^.x2d)) then continue; //то пропускаем ее
AB.x := B^.x2d-A^.x2d;//рассчитываем векторы сторон грани
AB.y := B^.y2d-A^.y2d;
BC.x := C^.x2d-B^.x2d;
BC.y := C^.y2d-B^.y2d;
CA.x := A^.x2d-C^.x2d;
CA.y := A^.y2d-C^.y2d;
AD.x := X+0.5 - A^.x2d; //рассчит. векторы от вершин грани до окна размером в пиксель
AD.y := Y+0.5 - A^.y2d; //причем в середине этого окна
BD.x := X+0.5 - B^.x2d; //для расчета принадлежности этого окна полигону
BD.y := Y+0.5 - B^.y2d;
CD.x := X+0.5 - C^.x2d;
CD.y := Y+0.5 - C^.y2d;
f1 := AB.x*AD.y - AD.x*AB.y; //находим векторные произведения векторов сторон грани
f2 := BC.x*BD.y - BD.x*BC.y; //с предыдущими рассчитанными векторами
f3 := CA.x*CD.y - CD.x*CA.y;
//если получились отрицательные числа для каждой стороны
//то окно внутри полигона
//если хотя бы одно равно 0 то окно находится на стороне
if ((f1<=0)and(f2<=0)and(f3<=0)) then
begin
Z := ZDepth(X,Y,P[i]); //ищем коорд. Z для этой точки
if (Z<Zmin) then //если ближе
begin
Zmin := Z;
in_WindowPainted := Colors[i];
end;
continue;
end;
end;
end;
procedure Figure.Varnok;
var
x,y,size:Longint;
flag: boolean;
V1: TPoint3d;
V2: Point3d;
ugol, tmp: extended;
num,count : Longint; //счетчики
polylst: array of TTriangle; //массив обрабатываемых граней
A,B,C:TPoint3d;
color: Longint;
LightPosition: Point3d;
Hue, Luminance, Saturation: Word;//для преобразования цвета из RGB в систему HLS
begin
V2.x:=0; //вектор направления взгляда
V2.y:=0;
V2.z:=-1;
num:=0;
for count:=0 to (numFaces-1) do
begin
V1 := polys[count]^.normal;
ugol:= V1^.x*V2.x + V1^.y*V2.y + V1^.z*V2.z; //проверяем совпадает ли направление взгляда
if (ugol>0) then //с нормалью. Если грань не видна то ugol будет меньше или равен нулю
begin
inc(num);
SetLength(polylst,num);
polylst[num-1] := polys[count];//видимые грани добавляем в список обрабатываемых
end;
end;
SetLength(Xmin,num); //расчитываем прямоугольные оболочки граней
SetLength(Xmax,num);
SetLength(Ymin,num);
SetLength(Ymax,num);
for count:=0 to (num-1) do
begin
A:=polylst[count]^.A;
B:=polylst[count]^.B;
C:=polylst[count]^.C;
if (A^.x2d<B^.x2d) then Xmin[count] := A^.x2d
else Xmin[count] := B^.x2d;
if (Xmin[count]>C^.x2d) then Xmin[count] := C^.x2d;
if (A^.x2d>B^.x2d) then Xmax[count] := A^.x2d
else Xmax[count] := B^.x2d;
if (Xmax[count]<C^.x2d) then Xmax[count] := C^.x2d;
if (A^.y2d<B^.y2d) then Ymin[count] := A^.y2d
else Ymin[count] := B^.y2d;
if (Ymin[count]>C^.y2d) then Ymin[count] := C^.y2d;
if (A^.y2d>B^.y2d) then Ymax[count] := A^.y2d
else Ymax[count] := B^.y2d;
if (Ymax[count]<C^.y2d) then Ymax[count] := C^.y2d;
end;
if (shading=3) then
begin
LightPosition.x:=0;
LightPosition.y:=0;
LightPosition.z:=-1000000;
SetLength(Colors, num);
for count:=0 to (num-1) do
begin
//находим вектор между источником света и любой точкой из грани
V2.x := LightPosition.x - polylst[count]^.A^.x;
V2.y := LightPosition.y - polylst[count]^.A^.x;
V2.z := LightPosition.z - polylst[count]^.A^.x;
tmp:=sqrt(V2.x*V2.x+V2.y*V2.y+V2.z*V2.z);//находим длину вектора
V2.x:=V2.x/tmp; //нормализуем вектор (приводим к единичной длине)
V2.y:=V2.y/tmp;
V2.z:=V2.z/tmp;
//расчет коэффициента яркости
//1 - макс. яркость, 0 - миним.
tmp := polylst[count]^.normal^.x*V2.x+polylst[count]^.normal^.y*V2.y + polylst[count]^.normal^.z*V2.z;
if (tmp<0) then tmp:=0;
if (tmp>1) then tmp:=1;
ColorRGBToHLS(objcolor,Hue, Luminance, Saturation);
Colors[count] := ColorAdjustLuma(objcolor,round(Luminance*tmp)-Luminance,true);
end;
end;
Push(0,0,1024); //заносим 1-е окно в стек
//причем длиной 1024 т.е. размер экрана не должен превышать 1024x1024
while (Counter>0) do //цикл работает пока есть хотя бы 1но окно в стеке
begin
Pop(x,y,size); //извлекаем окно из стека
flag:=false; //флаг пересечения грани с окном
for count:=0 to (num-1) do //цикл проверки всех прямоуг. оболочек граней на пересечение с окном
if (simple_triangle_Test(count,x,y,size)) then
begin
flag:=true; //если пересекает хотя бы одна грань то устанавливаем флаг
break;
end;
if (flag) then
begin
if (size>1) then //если окно больше пикселя то разбиваем его еще на 4
begin
size := size div 2;
Push(x+size,y+size,size);
Push(x,y+size,size);
Push(x+size,y,size);
Push(x,y,size);
end //if size
else //если грань пересекает окно размером с пиксел то рассчитываем цвет этой точки
begin
if (shading=3) then color:=in_WindowPainted(x,y,polylst,num) //если полутоновый
else color:=in_Window(x,y,polylst,num); //если контурный
if (color>=0) then
begin
SetPoint(x,y,color);//устанавливаем рассчитанный цвет пикселя
end;
end;
end;
end;
SetLength(polylst,0); //удаляем временные списки
SetLength(Xmin,0);
SetLength(Xmax,0);
SetLength(Ymin,0);
SetLength(Ymax,0);
if (shading=3) then SetLength(Colors,0);
end.
Unit 3:
procedure TOKBottomDlg.Button1Click(Sender: TObject);
begin
case RadioButton1.Checked of //если включен режим
true: //вращать "относительно начала координат"
begin
Figure1.RotateWorldCoord(5,0,0);
Form1.PaintBox1Paint(Sender);
end;
false:
begin
Figure1.RotateAboutPoint(Figure1.midpoint.x,Figure1.midpoint.y,Figure1.midpoint.z,5,0,0);
Form1.PaintBox1Paint(Sender);
end;
end;
end;
procedure TOKBottomDlg.Button2Click(Sender: TObject);
begin
case RadioButton1.Checked of
true:
begin
Figure1.RotateWorldCoord(-5,0,0);
Form1.PaintBox1Paint(Sender);
end;
false:
begin
Figure1.RotateAboutPoint(Figure1.midpoint.x,Figure1.midpoint.y,Figure1.midpoint.z,-5,0,0);
Form1.PaintBox1Paint(Sender);
end;
end;
end;
procedure TOKBottomDlg.Button3Click(Sender: TObject);
begin
case RadioButton1.Checked of
true:
begin
Figure1.RotateWorldCoord(0,5,0);
Form1.PaintBox1Paint(Sender);
end;
false:
begin
Figure1.RotateAboutPoint(Figure1.midpoint.x,Figure1.midpoint.y,Figure1.midpoint.z,0,5,0);
Form1.PaintBox1Paint(Sender);
end;
end;
end;
procedure TOKBottomDlg.Button4Click(Sender: TObject);
begin
case RadioButton1.Checked of
true:
begin
Figure1.RotateWorldCoord(0,-5,0);
Form1.PaintBox1Paint(Sender);
end;
false:
begin
Figure1.RotateAboutPoint(Figure1.midpoint.x,Figure1.midpoint.y,Figure1.midpoint.z,0,-5,0);
Form1.PaintBox1Paint(Sender);
end;
end;
end;
procedure TOKBottomDlg.Button5Click(Sender: TObject);
begin
case RadioButton1.Checked of
true:
begin
Figure1.RotateWorldCoord(0,0,5);
Form1.PaintBox1Paint(Sender);
end;
false:
begin
Figure1.RotateAboutPoint(Figure1.midpoint.x,Figure1.midpoint.y,Figure1.midpoint.z,0,0,5);
Form1.PaintBox1Paint(Sender);
end;
end;
end;
procedure TOKBottomDlg.Button6Click(Sender: TObject);
begin
case RadioButton1.Checked of
true:
begin
Figure1.RotateWorldCoord(0,0,-5);
Form1.PaintBox1Paint(Sender);
end;
false:
begin
Figure1.RotateAboutPoint(Figure1.midpoint.x,Figure1.midpoint.y,Figure1.midpoint.z,0,0,-5);
Form1.PaintBox1Paint(Sender);
end;
end;
end;
end.
Unit 4:
procedure TForm4.Button2Click(Sender: TObject);
begin
Figure1.Translate(5,0,0); //вызов метода для перемещения
Form1.PaintBox1Paint(Sender);
end;
procedure TForm4.Button3Click(Sender: TObject);
begin
Figure1.Translate(-5,0,0);
Form1.PaintBox1Paint(Sender);
end;
procedure TForm4.Button4Click(Sender: TObject);
begin
Figure1.Translate(0,5,0);
Form1.PaintBox1Paint(Sender);
end;
procedure TForm4.Button5Click(Sender: TObject);
begin
Figure1.Translate(0,-5,0);
Form1.PaintBox1Paint(Sender);
end;
end.
Unit 5:
procedure TForm5.Button2Click(Sender: TObject);
begin
Figure1.Scale( 1.1,1.1,1.1); //вызов метода для масштабирования
Form1.PaintBox1Paint(Sender);
end;
procedure TForm5.Button3Click(Sender: TObject);
begin
Figure1.Scale( 0.9,0.9,0.9); //вызов метода для масштабирования
Form1.PaintBox1Paint(Sender);
end;
end.