Для: masterdelphi
кинь сюда - попробуем разжевать.
TVector2f = Record {Вектор в двумерном пространстве}
X,Y:Real
End;
TVector = Record {Вектор в трехмерном пространстве}
X,Y,Z:Real
End;
TArrPoints = Array of TVector; {Координаты точек}
TInteger = Array [1..3] of Integer;
TArrLink = Array of TInteger; {Массив связей}
ArrPoints: TArrPoints; {Координаты точек}
ArrLink: TArrLink; {Массив связей}
Center: TVector; {Центр фигуры}
VertexNormals: TArrPoints; {Массив векторов нормалей к вершинам}
SunR, SunG, SunB: TVector; {Координаты источника света}
Rc,Gc,Bc: Boolean; {Включен/выкл. источники света}
Function LengthV (Var A : TVector): Real;
{Длина вектора А}
Function DotProduct (Var A, B : TVector): Real;
{Скалярное произведение векторов A и B}
Procedure GouraudHLine(X1,X2,Y:Integer;C1,C2:TColor);
Var I,tmp :Integer;
C
Word;
C1R,C1G,C1B :Byte;
C2R,C2G,C2B :Byte;
n1r,n1g,n1b :Byte;
Begin {==================== Гор. линия для метода Гуру ====================}
C1:=((C1 and $FF) shl 16)+(((C1 shr 8) and $FF) shl 8)+((C1 shr 16) and $FF);
C2:=((C2 and $FF) shl 16)+(((C2 shr 8) and $FF) shl 8)+((C2 shr 16) and $FF);
If X2<X1 then Begin tmp:=X1;X1:=X2;X2:=tmp;C:=C1;C1:=C2;C2:=C;End;
C1R:=C1 shr 16; C1G:=C1 shr 8; C1B:=C1;
C2R:=C2 shr 16; C2G:=C2 shr 8; C2B:=C2;
if x2=x1 then
Begin
MainForm.Canv.DIB.Pixels[X1,Y]:=C1;
Exit;
End;
with MainForm.canv.DIB do
For I:=X1 to X2 do
Begin
n1r:=round(c1r+(I-X1)*(c2r-c1r)/(x2-x1));
n1g:=round(c1g+(I-X1)*(c2g-c1g)/(x2-x1));
n1b:=round(c1b+(I-X1)*(c2b-c1b)/(x2-x1));
C:=(n1r shl 16)+(n1g shl 8)+n1b;
Pixels[I,Y]:=C;
End;
End;
Procedure GouraudTriangle(X1,Y1,X2,Y2,X3,Y3:Integer;C1,C2,C3:TColor);
var tmp,sy,sx1,sx2 :Integer;
tc,c,rc1,rc2
Word;
l1,l2,l3,sl1,sl2 :Real;
u,w,t :Real;
e1r,e1g,e1b :Real;
e2r,e2g,e2b :Real;
c1r,c1g,c1b :Word;
c2r,c2g,c2b :Word;
c3r,c3g,c3b :Word;
Begin {==================== Интерполированный треугольник (по Гуро) ====================}
// здесь сортируем вершины (A,B,C)
if (y1>y2) then Begin tmp:=y1;y1:=y2;y2:=tmp;tmp:=x1;x1:=x2;x2:=tmp;tc:=C1;C1:=C2;C2:=tc;End;
if (y1>y3) then Begin tmp:=y1;y1:=y3;y3:=tmp;tmp:=x1;x1:=x3;x3:=tmp;tc:=C1;C1:=C3;C3:=tc;End;
if (y2>y3) then Begin tmp:=y2;y2:=y3;y3:=tmp;tmp:=x2;x2:=x3;x3:=tmp;tc:=C2;C2:=C3;C3:=tc;End;
if (y1=y3) then Exit;
// Вычисление длин всех ребер
l1:=sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1));
l2:=sqrt((x3-x2)*(x3-x2)+(y3-y2)*(y3-y2));
l3:=sqrt((x3-x1)*(x3-x1)+(y3-y1)*(y3-y1));
// Цветовые компоненты
c1r:=(c1 shr 16) and $FF;c1g:=(c1 shr 8) and $FF;c1b:=c1 and $FF;
c2r:=(c2 shr 16) and $FF;c2g:=(c2 shr 8) and $FF;c2b:=c2 and $FF;
c3r:=(c3 shr 16) and $FF;c3g:=(c3 shr 8) and $FF;c3b:=c3 and $FF;
// Теперь проходим по первой полвине треугольника (1,2,4);
if ((y1<>y2) and (l1<>0) and (l3<>0)) then
for sy:=y1 to y2 do
Begin
sx1:=round(x1+(sy-y1)*(x3-x1)/(y3-y1));
sx2:=round(x1+(sy-y1)*(x2-x1)/(y2-y1));
sl1:=sqrt((sy-y1)*(sy-y1)+(sx1-x1)*(sx1-x1));
sl2:=sqrt((sy-y1)*(sy-y1)+(sx2-x1)*(sx2-x1));
u:=sl1/l3;
w:=sl2/l1;
e1r:=u*c3r+(1-u)*c1r;e1g:=u*c3g+(1-u)*c1g;e1b:=u*c3b+(1-u)*c1b;
e2r:=w*c2r+(1-w)*c1r;e2g:=w*c2g+(1-w)*c1g;e2b:=w*c2b+(1-w)*c1b;
C1:=(trunc(e1r) shl 16)+(trunc(e1g) shl 8)+trunc(e1b);
C2:=(trunc(e2r) shl 16)+(trunc(e2g) shl 8)+trunc(e2b);
GouraudHLine(sx1,sx2,sy,C1,C2);
End;
// Теперь проходим по второй полвине треугольника (2,4,3);
if ((y2<>y3) and (l2<>0) and (l3<>0)) then
for sy:=y2 to y3 do
Begin
sx1:=round(x1+(sy-y1)*(x3-x1)/(y3-y1));
sx2:=round(x2+(sy-y2)*(x3-x2)/(y3-y2));
sl1:=sqrt((sy-y1)*(sy-y1)+(sx1-x1)*(sx1-x1));
sl2:=sqrt((sy-y2)*(sy-y2)+(sx2-x2)*(sx2-x2));
u:=sl1/l3;
w:=sl2/l2;
e1r:=u*c3r+(1-u)*c1r;e1g:=u*c3g+(1-u)*c1g;e1b:=u*c3b+(1-u)*c1b;
e2r:=w*c3r+(1-w)*c2r;e2g:=w*c3g+(1-w)*c2g;e2b:=w*c3b+(1-w)*c2b;
C1:=(trunc(e1r) shl 16)+(trunc(e1g) shl 8)+trunc(e1b);
C2:=(trunc(e2r) shl 16)+(trunc(e2g) shl 8)+trunc(e2b);
GouraudHLine(sx1,sx2,sy,C1,C2);
End;
End;
//##############################################################################
procedure TMainForm.CalcGouraudColor(N: Integer; Var R,G,B: Integer);
Var S: TVector;
R1,G1,B1: Real;
Begin {================ Расчет освещенности по Гуру ================}
S.x:=SunR.x-ArrPoints[N].x;
S.y:=SunR.y-ArrPoints[N].y;
S.z:=SunR.z-ArrPoints[N].z;
R1:= 0.5 + 0.5 * DotProduct(VertexNormals[N], S) / LengthV(S);
S.x:=SunG.x-ArrPoints[N].x;
S.y:=SunG.y-ArrPoints[N].y;
S.z:=SunG.z-ArrPoints[N].z;
G1:= 0.5 + 0.5 * DotProduct(VertexNormals[N], S) / LengthV(S);
S.x:=SunB.x-ArrPoints[N].x;
S.y:=SunB.y-ArrPoints[N].y;
S.z:=SunB.z-ArrPoints[N].z;
B1:= 0.5 + 0.5 * DotProduct(VertexNormals[N], S) / LengthV(S);
IF Not Rc Then R1:=0;
IF Not Gc Then G1:=0;
IF Not Bc Then B1:=0;
R:=Round(R1*255);
G:=Round(G1*255);
B:=Round(B1*255);
End;
procedure GouraudFace(N: Integer);
Var R,G,B, R1,G1,B1, R2,G2,B2: Integer;
begin {============ Вывод интерполированной закрашенной грани ============}
With MainForm do
Begin
CalcGouraudColor(ArrLink[N,1], R,G,
;
CalcGouraudColor(ArrLink[N,2], R1,G1,B1);
CalcGouraudColor(ArrLink[N,3], R2,G2,B2);
GouraudTriangle(
Round(Get2dX(ArrPoints[ArrLink[N,1]])),
Round(Get2dY(ArrPoints[ArrLink[N,1]])),
Round(Get2dX(ArrPoints[ArrLink[N,2]])),
Round(Get2dY(ArrPoints[ArrLink[N,2]])),
Round(Get2dX(ArrPoints[ArrLink[N,3]])),
Round(Get2dY(ArrPoints[ArrLink[N,3]])),
RGB(R,G,
,RGB(R1,G1,B1),RGB(R2,G2,B2));
End;
end;
для половины функций я не могу найти пояснения,это только процедура именно расчета освещения, я че-то не могу понять где здесь метод Гуро,+ эта программа состоит из 4 подпрограмм, я могу скинуть целую папку кода к этой проге