Giáo trình Lý thuyết đồ họa

 
 truoc:=j+1; 
 if j=n then truoc:=1; 
 sau:=j-1; 
 if j=1 then sau:=n; 
 if i=P[j].x then 
 begin 
 if (i>min(P[sau].x,P[truoc].x))and 
 (i<max(P[sau].x,P[truoc].x)) then 
 begin 
 inc(m); 
 z[m]:=P[j].y; 
 end 
 else 
 begin 
 inc(m); 
 z[m]:=P[j].y; 
 inc(m); 
 z[m]:=P[j].y; 
 end; 
 end; 
 if (i>min(P[j].x,P[truoc].x))and 
 (i<max(P[truoc].x,P[j].x)) then 
 begin 
 inc(m); 
 r:=(P[truoc].y-P[j].y)/(P[truoc].x-P[j].x); 
 z[m]:=P[j].y+trunc(r*(i-P[j].x)); 
 end; 
 end; 
 for j:=1 to m-1 do 
 for k:=j+1 to m do 
 if z[j]>z[k] then 
 begin 
 tg:=z[j];z[j]:=z[k];z[k]:=tg; 
 end; 
 setcolor(mau2); 
 For k:=1 to m-1 do 
 if k mod 20 then line(i,z[k],i,z[k+1]); 
 end; 
Phụ lục. Một số chương trỡnh minh họa 
124 
End; 
Procedure ThietLapDoHoa; 
var Gd,Gm:Integer; 
Begin 
 Gd:=0; 
 InitGraph(Gd,Gm,’C:\BP\BGI’); 
End; 
Begin 
 CLRSCR; 
 NhapDuLieu(a,n); 
 minx:=a[1].x; 
 maxx:=minx; 
 miny:=a[1].y; 
 maxy:=miny; 
 for i:=1 to n do 
 begin 
 if minx>a[i].x then minx:=a[i].x; 
 if miny>a[i].y then miny:=a[i].y; 
 if maxx<a[i].x then maxx:=a[i].x; 
 if maxy<a[i].x then maxy:=a[i].y; 
 end; 
 ThietLapDoHoa; 
 vedagiac(a,n); 
 Tomau(a,n); 
 readln; 
 closegraph; 
end. 
2. Thuật toỏn tụ loang (ðệ qui) 
uses crt, graph; 
Type ToaDo=record 
 x,y:integer; 
 End; 
 Mang=array[0..30] of ToaDo; 
Var a:Mang; 
 x,y,n,Gd,Gm:Integer; 
procedure NhapDaGiac(Var n:integer); 
var i:integer; 
begin 
 clrscr; 
 write('Nhap vao so dinh cua mot da giac n= '); 
 readln(n); 
 for i:=1 to n do 
 begin 
 writeln('Toa do dinh thu',i,'la:'); 
 write('a[',i,'].x='); 
 readln(a[i].x); 
Phụ lục. Một số chương trỡnh minh họa 
125 
 write('a[',i,'].y='); 
 readln(a[i].y); 
 end; 
 Write('Nhap x= '); Readln(x); 
 Write('Nhap y= '); Readln(y); 
end; 
Procedure VeDaGiac(n,color:integer); 
 var i,j:byte; 
 begin 
 SetColor(Color); 
 for i:=1 to n do 
 begin 
 if i=n then j:=1 else j:=i+1; 
 line(a[i].x,a[i].y,a[j].x,a[j].y); 
 end; 
 end; 
Function Max(a,b:integer):integer; 
 Begin 
 if a<b then Max:=b else Max:=a; 
 End; 
Function Min(a,b:integer):integer; 
 Begin 
 if a<b then Min:=a else Min:=b; 
 End; 
Function KiemTra(x,y:Integer;a:Mang):Boolean; 
 var dem,i,j,s:Integer; 
 Begin 
 dem:=0; 
 for i:=1 to n do { Tim so giao diem } 
 begin 
 if i=n then j:=1 else j:=i+1; 
 if i=1 then s:=n else s:=i-1; 
 if x=a[i].x then 
 begin 
 if y<a[i].y then 
 if (x<=Min(a[s].x ,a[j].x)) OR 
 (x>=Max(a[s].x,a[j].x)) then dem:=dem+2 
 else dem:=dem+1; 
 end 
 else 
 if (x>Min(a[i].x,a[j].x))and(x<Max(a[j].x,a[i].x)) 
then 
 if y<=Min(a[i].y,a[j].y) then dem:=dem+1 
 else if y <= (x-a[j].x)*(a[i].y-a[j].y)/(a[i].x-
 a[j].x)+a[j].y then dem:=dem+1; 
 end; 
 if dem mod 2=1 then KiemTra:=True else KiemTra:=False; 
Phụ lục. Một số chương trỡnh minh họa 
126 
 End; 
Procedure ToLoang(x,y:Integer;color:Byte); 
 Begin 
 if KiemTra(x,y,a) and (GetPixel(x,y)color) then 
 Begin 
 PutPixel(x,y,color); 
 ToLoang(x+1,y,color); 
 ToLoang(x-1,y,color); 
 ToLoang(x,y+1,color); 
 ToLoang(x,y-1,color); 
 End; 
 End; 
BEGIN 
 Nhapdagiac(n); 
 Gd:=Detect; 
 InitGraph(Gd,Gm,'D:\TP\BGI'); 
 Vedagiac(n,4); 
 Toloang(x,y,14); 
 readln; 
 closegraph; 
END. 
3. Thuật toỏn tụ loang (Khử ủệ qui) 
Uses crt, graph; 
Type ToaDo=record 
 x,y:integer; 
 End; 
 DANHSACH=^DS; 
 DS=Record 
 Data:ToaDo; 
 Next:DANHSACH; 
 End; 
 Mang=array[0..30] of ToaDo; 
Var Stack:DanhSach; 
 a:Mang; 
 x,y,n,Gd,Gm:Integer; 
Procedure KhoiTaoStack; 
 Begin 
 Stack:=Nil; 
 End; 
Procedure PUSHStack(a:ToaDo;Var Stack:DanhSach); 
{ Nhap vao dau danh sach } 
 Var p:DanhSach; 
 Begin 
 new(p); 
 p^.Data:=a; p^.next:=nil; 
 p^.next:=Stack; 
Phụ lục. Một số chương trỡnh minh họa 
127 
 Stack:=p; 
 End; 
Procedure POPStack(Var Stack:DanhSach;var x,y:Integer); 
{ Lay ra o dau danh sach } 
 Var p:DanhSach; 
 Begin 
 If Stacknil then 
 Begin 
 p:=Stack; 
 Stack:=Stack^.next; 
 x:=p^.Data.x; 
 y:=p^.Data.y; 
 Dispose(p); 
 End; 
 End; 
procedure NhapDaGiac(Var n:integer;var a:Mang); 
var i:integer; 
begin 
 clrscr; 
 write('Nhap vao so dinh cua mot da giac n= '); 
 readln(n); 
 for i:=1 to n do 
 begin 
 writeln('Toa do dinh thu',i,'la:'); 
 write('a[',i,'].x='); 
 readln(a[i].x); 
 write('a[',i,'].y='); 
 readln(a[i].y); 
 end; 
 Write('Nhap x= '); Readln(x); 
 Write('Nhap y= '); Readln(y); 
end; 
Procedure VeDaGiac(n,color:integer); 
 var i,j:byte; 
 begin 
 SetColor(Color); 
 for i:=1 to n do 
 begin 
 if i=n then j:=1 else j:=i+1; 
 line(a[i].x,a[i].y,a[j].x,a[j].y); 
 end; 
 end; 
Function Max(a,b:integer):integer; 
 Begin 
 if a<b then Max:=b else Max:=a; 
 End; 
Phụ lục. Một số chương trỡnh minh họa 
128 
Function Min(a,b:integer):integer; 
 Begin 
 if a<b then Min:=a else Min:=b; 
 End; 
Function KiemTra(x,y:Integer;a:Mang):Boolean; 
 var dem,i,j,s:Integer; 
 Begin 
 dem:=0; 
 for i:=1 to n do { Tim so giao diem } 
 begin 
 if i=n then j:=1 else j:=i+1; 
 if i=1 then s:=n else s:=i-1; 
 if x=a[i].x then 
 begin 
 if y<a[i].y then 
 if (x<=Min(a[s].x ,a[j].x))OR 
 (x>=Max(a[s].x,a[j].x)) then dem:=dem+2 
 else dem:=dem+1; 
 end 
 else 
 if (x>Min(a[i].x,a[j].x)) and 
 (x<Max(a[j].x,a[i].x)) then 
 if y<=Min(a[i].y,a[j].y) then dem:=dem+1 
 else if y <= (x-a[j].x)*(a[i].y-a[j].y)/ 
 (a[i].x-a[j].x)+a[j].y then dem:=dem+1; 
 end; 
 KiemTra:=dem mod 2=1; 
 End; 
Procedure ToLoang(x,y:Integer;color:Byte); 
 Var B,C:ToaDo; 
 Begin 
 if KiemTra(x,y,a) and (GetPixel(x,y)color) then 
 Begin 
 PutPixel(x,y,color); 
 B.x:=x+1; B.y:=y; 
 PUSHStack(B,Stack); 
 B.x:=x-1; B.y:=y; 
 PUSHStack(B,Stack); 
 B.x:=x; B.y:=y+1; 
 PUSHStack(B,Stack); 
 B.x:=x; B.y:=y-1; 
 PUSHStack(B,Stack); 
 End; 
 While Stacknil do 
 Begin 
 POPStack(Stack,B.x,B.y); 
 if KiemTra(B.x,B.y,a) and 
Phụ lục. Một số chương trỡnh minh họa 
129 
 GetPixel(B.x,B.y)color) then 
 Begin 
 PutPixel(B.x,B.y,color); 
 C.x:=B.x+1; C.y:=B.y; 
 if KiemTra(C.x,C.y,a) and 
 (GetPixel(C.x,C.y)color) then 
 PUSHStack(C,Stack); 
 C.x:=B.x-1; C.y:=B.y; 
 if KiemTra(C.x,C.y,a) and 
 (GetPixel(C.x,C.y)color) then 
 PUSHStack(C,Stack); 
 C.x:=B.x; C.y:=B.y+1; 
 if KiemTra(C.x,C.y,a) and 
 (GetPixel(C.x,C.y)color) then 
 PUSHStack(C,Stack); 
 C.x:=B.x; C.y:=B.y-1; 
 if KiemTra(C.x,C.y,a) and 
 (GetPixel(C.x,C.y)color) then 
 PUSHStack(C,Stack); 
 End; 
 End; 
 End; 
BEGIN 
 KhoiTaoStack; 
 Nhapdagiac(n,a); 
 Gd:=Detect; 
 InitGraph(Gd,Gm,'D:\TP\BGI'); 
 Vedagiac(n,4); 
 Toloang(x,y,14); 
 readln; 
 closegraph; 
END. 
II. CÁC THUẬT TOÁN XẫN HèNH 
1. Thuật toỏn Cohen Sutherland 
Uses crt,graph; 
Const LEFT=1; 
 RIGHT=2; 
 BELOW=4; 
 ABOVE=8; 
Type ToaDo2D=record 
 x,y:integer; 
 end; 
var Tren,Duoi,A,B:ToaDo2D; 
 gd,gm:Integer; 
 ch:char; 
Phụ lục. Một số chương trỡnh minh họa 
130 
procedure NhapDinhHCN; 
 begin 
 Tren.x:=100; 
 Tren.y:=100; 
 Duoi.x:=450; 
 Duoi.y:=350; 
 randomize; 
 a.x:=random(GetMaxx); 
 a.y:=random(GetMaxY); 
 b.x:=random(GetMaxx); 
 b.y:=random(GetMaxY); 
 end; 
PROCEDURE VeHCN; 
 begin 
 line(Tren.x,Tren.y,Duoi.x,Tren.y); 
 line(Duoi.x,Tren.y,Duoi.x,Duoi.y); 
 line(Duoi.x,Duoi.y,Tren.x,Duoi.y); 
 line(Tren.x,Duoi.y,Tren.x,Tren.y); 
 setwritemode(xorput); 
 line(a.x,a.y,b.x,b.y); 
 ch:=readkey; 
 line(a.x,a.y,b.x,b.y); 
 setwritemode(orput); 
 end; 
FUNCTION MA(P:ToaDo2D):Byte; 
 var s:Byte; 
BEGIN 
 s:=0; 
 if P.x<Tren.x then s:=s OR Left; 
 if P.x>Duoi.x then s:=s OR Right; 
 if P.y<Tren.y then s:=s OR Above; 
 if P.y>Duoi.y then s:=s OR Below; 
 Ma:=s; 
end; 
Procedure Swap(Var A,B:ToaDo2D); 
var t:ToaDo2D; 
 Begin 
 t:=a; a:=b; b:=t; 
 End; 
Procedure Clipping(A,B,Tren,Duoi:ToaDo2D); 
Var stop,draw:Boolean; 
 m:Real; 
Begin 
 stop:=False; draw:=False; 
 While not stop do 
 Begin 
Phụ lục. Một số chương trỡnh minh họa 
131 
 If (Ma(A)=0)and(Ma(B)=0) then 
 Begin 
 stop:=True; draw:=True; 
 End 
 else 
 If (Ma(A) and Ma(B)0) then stop:=True 
 else 
 Begin 
 If (Ma(A)and Ma(B)=0)and 
 (Ma(A)0)or(Ma(B)0)) then 
 Begin 
 if Ma(A)=0 then Swap(A,B); {A luon nam ngoai} 
 if A.x=B.x then 
 Begin 
 if Ma(A) and ABOVE0 then A.y:=Tren.y 
 else A.y:=Duoi.y; 
 if Ma(B)0 then 
 Begin 
 if Ma(B) and ABOVE0 then B.y:=Tren.y; 
 if Ma(B) and BELOW0 then B.y:=Duoi.y; 
 End; 
 stop:=True; draw:=True; 
 End 
 else {AxBx} 
 Begin 
 m:=(B.y-A.y)/(B.x-A.x); 
 If Ma(A) and LEFT0 then 
 Begin 
 A.y:=round((Tren.x - A.x)*m + A.y); 
 A.x:=Tren.x; 
 End 
 else 
 If Ma(A) and RIGHT0 then 
 Begin 
 A.y:=round((Duoi.x - A.x)*m + A.y); 
 A.x:=Duoi.x; 
 End 
 else 
 If Ma(A) and ABOVE0 then 
 Begin 
 A.x:=round((Tren.y - A.y)/m + A.x); 
 A.y:=Tren.y; 
 End 
 else 
 If Ma(A) and BELOW0 then 
 Begin 
 A.x:=round((Duoi.y - A.y)/m +A.x); 
 A.y:=Duoi.y; 
Phụ lục. Một số chương trỡnh minh họa 
132 
 End; 
 End; 
 End; 
 End; 
 End; 
 setcolor(14); 
 If draw then Line(A.x,A.y,B.x,B.y); 
 setcolor(15); 
End; 
BEGIN 
 gd:=detect; Initgraph(gd,gm,'D:\TP\BGI'); 
 repeat 
 NhapDinhHCN; 
 VeHCN; 
 Clipping(A,B,Tren,Duoi); 
 until ch=#27; 
 closegraph; 
END. 
2. Thuật toỏn chia nhị phõn 
Uses crt,graph; 
type ToaDo2D=record 
 x,y:integer; 
 end; 
var Tren,Duoi,A,B:ToaDo2D; 
 gd,gm:Integer; 
procedure NhapDinhHCN; 
 begin 
 Tren.x:=100; 
 Tren.y:=100; 
 Duoi.x:=300; 
 Duoi.y:=200; 
 a.x:=352; 
 a.y:=122; 
 b.x:=22; 
 b.y:=23; 
 end; 
PROCEDURE VeHCN; 
 begin 
 line(Tren.x,Tren.y,Duoi.x,Tren.y); 
 line(Duoi.x,Tren.y,Duoi.x,Duoi.y); 
 line(Duoi.x,Duoi.y,Tren.x,Duoi.y); 
 line(Tren.x,Duoi.y,Tren.x,Tren.y); 
 setwritemode(xorput); 
 line(a.x,a.y,b.x,b.y); 
 readln; 
Phụ lục. Một số chương trỡnh minh họa 
133 
 line(a.x,a.y,b.x,b.y); 
 end; 
FUNCTION MA(P:ToaDo2D):Byte; 
 var s:Byte; 
BEGIN 
 s:=0; 
 if P.x<Tren.x then s:=s OR Left; 
 if P.x>Duoi.x then s:=s OR Right; 
 if P.y<Tren.y then s:=s OR Above; 
 if P.y>Duoi.y then s:=s OR Below; 
 Ma:=s; 
end; 
PROCEDURE XuLyATrongBNgoai(A,B:ToaDo2D); 
 Var C,D,M:ToaDo2D; 
 begin 
 c:=a;d:=b; 
 While abs(C.x-D.x)+abs(C.y-D.y)>2 do 
 begin 
 M.x:=round((C.x+D.x)/2); 
 M.y:=round((C.y+D.y)/2); 
 if ma(M)0 then D:=M else C:=M; 
 end; 
 line(A.x,A.y,C.x,C.y); 
 end; 
PROCEDURE Clipping(A,B,Tren,Duoi:ToaDo2D); 
Var C,D,M:ToaDo2D; 
Begin 
 if (ma(a)=0) and (ma(b)=0) then line(a.x,a.y,b.x,b.y); 
 if (ma(a)=0) and (ma(b)0) then XulyATrongBNgoai(A,B); 
 if (ma(a)0) and (ma(b)=0) then XulyATrongBNgoai(B,A); 
 if (ma(A)0) and (ma(B)0) and ((ma(A) and ma(B))=0) 
then 
 begin 
 C:=A; D:=B; 
 M.x:=(C.x+D.x)div 2; 
 M.y:=(C.y+D.y)div 2; 
 while (ma(M)0)and(abs(C.x-D.x)+abs(C.y-D.y)>2) do 
 begin 
 if (ma(C) and ma(M))0 then C:=M else D:=M; 
 M.x:=(C.x+D.x)div 2; 
 M.y:=(C.y+D.y)div 2; 
 end; 
 if ma(M)=0 then 
 begin 
 XulyATrongBNgoai(M,A); 
 XulyATrongBNgoai(M,B); 
 end; 
Phụ lục. Một số chương trỡnh minh họa 
134 
 end; 
End; 
BEGIN 
 NhapDinhHCN; 
 gd:=detect; Initgraph(gd,gm,'D:\TP\BGI'); 
 VeHCN; 
 Clipping(A,B,Tren,Duoi); 
 readln; 
 closegraph; 
 END. 
3. Thuật toỏn Liang-Barsky 
Uses crt,graph; 
var PTop,PBottom,A,B:PointType; 
 gd,gm:Integer; 
procedure NhapDinhHCN; 
var i:integer; 
begin 
 writeln('Nhap toa do dinh tren trai cua HCN:'); 
 write('x1=');readln(PTop.x); 
 write('y1=');readln(PTop.y); 
 writeln('Nhap toa do dinh duoi phai cua HCN:'); 
 write('x2=');readln(PBottom.x); 
 write('y2=');readln(PBottom.y); 
 writeln('Nhap toa do dinh thu nhat cua duong thang:'); 
 write('a.x=');readln(a.x); 
 write('a.y=');readln(a.y); 
 writeln('Nhap toa do dinh thu hai cua duong thang:'); 
 write('b.x='); readln(b.x); 
 write('b.y='); readln(b.y); 
end; 
PROCEDURE VeHCN; 
 begin 
 line(PTop.x,PTop.y,PBottom.x,PTop.y); 
 line(PBottom.x,PTop.y,PBottom.x,PBottom.y); 
 line(PBottom.x,PBottom.y,PTop.x,PBottom.y); 
 line(PTop.x,PBottom.y,PTop.x,PTop.y); 
 setwritemode(xorput); 
 line(a.x,a.y,b.x,b.y); 
 readln; 
 line(a.x,a.y,b.x,b.y); 
 end; 
Function Clip(p,q:real; Var u1,u2:real):Boolean; 
 Var r:real; 
 Begin 
 Clip:=True; 
Phụ lục. Một số chương trỡnh minh họa 
135 
 If p<0 then 
 Begin 
 r:=q/p; 
 If r>u2 then Clip:=False else If r>u1 then u1:=r; 
 End 
 else If p>0 then 
 Begin 
 r:=q/p; 
 If r<u1 then Clip:=False 
 else If r<u2 then u2:=r; 
 End 
 else If q<0 then Clip:=False; 
 End; 
Procedure LiangBaskyClip(p1,p2,PTop,PBottom:PointType); 
 Var u1,u2,dx,dy:real; 
 Begin 
 u1:=0; u2:=1; 
 dx:=p2.x - p1.x; 
 If Clip(-dx,p1.x - PTop.x,u1,u2) then 
 If Clip(dx,PBottom.x - p1.x,u1,u2) then 
 Begin 
 dy:=P2.y - P1.y; 
 If Clip(-dy,p1.y - PTop.y,u1,u2) then 
 If Clip(dy,PBottom.y - p1.y,u1,u2) then 
 Begin 
 If u2<1 then 
 Begin 
 p2.x:=p1.x + Round(u2*dx); 
 p2.y:=p1.y + Round(u2*dy); 
 End; 
 If u1>0 then 
 Begin 
 p1.x:=p1.x + Round(u1*dx); 
 p1.y:=p1.y + Round(u1*dy); 
 End; 
 Line(p1.x,p1.y,p2.x,p2.y); 
 End; 
 End; 
 End; 
BEGIN 
 clrscr; 
 NhapDinhHCN; 
 gd:=detect; Initgraph(gd,gm,'D:\TP\BGI'); 
 VeHCN; 
 LiangBaskyClip(a,b,PTop,PBottom); 
 readln; 
 closegraph; 
Phụ lục. Một số chương trỡnh minh họa 
136 
END. 
III. VẼ CÁC ðỐI TƯỢNG 3D 
1. Vẽ mặt yờn ngựa 
USES crt, graph, DOHOA3d ; {Su dung Unit DoHoa3D} 
VAR u,uMin, uMax,du : real; 
 v,vMin, vMax, dv : real; 
 a1,a2,b1,b2,c1,c2,d : integer; 
PROCEDURE Nhap_tham_so; 
BEGIN 
 projection := Phoicanh; 
 rho := 50; de := 2000; 
 theta := 40; phi := 20; 
 uMin := -1; uMax := 1 ; 
 vMin := -1 ; vMax:= 1 ; 
 du := 0.095; dv := 0.09; 
 a1:= 0; a2:=0; 
 b1:= 0; b2:=0; 
 c1:= 0; c2:=0; 
 d := 1; 
END; 
FUNCTION fx(u,v:real): real; 
BEGIN 
 fx:=a1*cos(u) + b1*cos(v) + c1*cos(u)*cos(v) + d*u; 
END; 
FUNCTION fy(u,v:real): real; 
BEGIN 
 fy:=a1*cos(u) + b1*sin(v) + c2*cos(u)*sin(v) + d*v ; 
END ; 
FUNCTION fz(u,v:real): real; 
BEGIN 
 fz := a2*sin(u) +b2*sin(v) + d*u*u - d*v*v ; 
END ; 
PROCEDURE ho_duong_cong_u ; 
VAR P :ToaDo3D; 
BEGIN 
 u := uMin; {Mat cat U ban dau} 
 WHILE u<=uMax DO 
 BEGIN 
 v :=vMin; {Mat cat V ban dau} 
 P.x :=fx(u,v); 
 P.y :=fy(u,v); 
 P.z :=fz(u,v); 
 DiDen(P); {Move to point (x,y,z) ban dau} 
 WHILE v <= vMax DO {Thay doi mat cat V} 
Phụ lục. Một số chương trỡnh minh họa 
137 
 BEGIN 
 P.x :=fx(u,v); 
 P.y :=fy(u,v); 
 P.z := fz(u,v); 
 VeDen(P); {Ve den diem (x,y,z) moi} 
 v := v+dv; {tang gia tri mat cat V} 
 END; 
 u:=u+du; {tang gia tri mat cat U} 
 END; 
END; 
PROCEDURE ho_duong_cong_v ; 
VAR P :ToaDo3D; 
BEGIN 
 v := vMin; {Mat cat V ban dau} 
 WHILE v<=vMax DO 
 BEGIN 
 u :=vMin; {Mat cat U ban dau} 
 P.x :=fx(u,v); 
 P.y :=fy(u,v); 
 P.z :=fz(u,v); 
 DiDen(P); 
 WHILE u <= uMax DO 
 BEGIN 
 P.x :=fx(u,v); 
 P.y :=fy(u,v); 
 P.z := fz(u,v); 
 VeDen(P); 
 u := u+du; {tang gia tri mat cat U} 
 END; 
 v :=v+dv; {tang gia tri mat cat V} 
 END; {of while v} 
END; 
PROCEDURE DEMO; 
BEGIN 
 nhap_tham_so; 
 REPEAT 
 XoaManHinh; 
 KhoiTaoPhepChieu; 
 ho_duong_cong_u ; 
 ho_duong_cong_v ; 
 DieuKhienQuay; 
 UNTIL upcase(ch) = char(27); 
END; 
BEGIN { Main program } 
 ThietLapDoHoa; 
 demo; 
 CloseGraph; 
Phụ lục. Một số chương trỡnh minh họa 
138 
END. 
2. Vẽ cỏc ủối tượng WireFrame 
uses crt,Graph,DoHoa3D; 
Const MaxDinh=50; 
 MaxCanh=100; 
Type WireFrame=Record 
 SoDinh:0..MaxDinh; 
 Dinh:Array[1..MaxDinh] of ToaDo3D; 
 SoCanh:0..MaxCanh; 
 Canh:Array[1..MaxCanh,1..2] of 1..MaxDinh; 
 End; 
Var a:WireFrame; 
Procedure KhoiTaoBien; 
 Begin 
 Rho:=5; Theta:=20; 
 Phi:=20; De:=3; 
 End; 
Procedure DocFile(FileName:String; Var WF:WireFrame); 
var f:Text; 
 x,i:Integer; 
 Begin 
 assign(f,FileName); 
 Reset(f); 
 With WF do 
 Begin 
 read(f,x); SoDinh:=x; 
 read(f,x); SoCanh:=x; 
 For i:=1 to SoDinh do {Doc so dinh} 
 Begin 
 read(f,x); Dinh[i].x:=x; 
 read(f,x); Dinh[i].y:=x; 
 read(f,x); Dinh[i].z:=x; 
 End; 
 For i:=1 to SoCanh do {Doc so Canh} 
 Begin 
 read(f,x); Canh[i,1]:=x; 
 read(f,x); Canh[i,2]:=x; 
 End; 
 End; 
 Close(f); 
 End; 
Procedure VeWireFrame(WF:WireFrame); 
 Var i:Byte; 
 d1,d2:ToaDo3D; 
 Begin 
Phụ lục. Một số chương trỡnh minh họa 
139 
 With WF do 
 Begin 
 for i:=1 to SoCanh do 
 Begin 
 d1:=Dinh[Canh[i,1]]; 
 d2:=Dinh[Canh[i,2]]; 
 DiDen(d1); 
 VeDen(d2); 
 End; 
 End; 
 End; 
Begin 
 DocFile('bacdien.txt',a); 
 Projection:=SongSong{PhoiCanh}; 
 ThietLapDoHoa; 
 KhoiTaoBien; 
 repeat 
 KhoiTaoPhepChieu; 
 VeWireFrame(a); 
 DieuKhienQuay; 
 until ch=#27; 
 CloseGraph; 
End. 
3. Khử mặt khuất theo giải thuật BackFace 
Uses crt,graph,DoHoa3D; 
Const MaxSoDinh=50; 
 MaxSoMat =30; 
 MaxDinh =10; 
Type TapDinh=Array[1..MaxSoDinh] of ToaDo3D; 
 TapMat=Array[1..MaxSoMat,0..MaxDinh] of Integer; 
 FaceModel=Record 
 SoDinh:Integer; 
 Dinh:TapDinh; 
 SoMat:Integer; 
 Mat:TapMat; 
 End; 
Var Hinh:FaceModel; 
 O:ToaDo3D; 
Procedure KhoiTao; 
 Begin 
 Projection:=Phoicanh; 
 Rho:=1500; Theta:=20; 
 Phi:=15; DE:=3000; 
 End; 
Procedure VectorNhin(Dinh1,Dinh2,Dinh3:Integer; 
 Var v:toaDo3D); 
Phụ lục. Một số chương trỡnh minh họa 
140 
 Begin 
 With hinh do 
 Begin 
 v.x:=O.x - Dinh[Dinh1].x; 
 v.y:=O.y - Dinh[Dinh1].y; 
 v.z:=O.z - Dinh[Dinh1].z; 
 end; 
 End; 
Procedure VectorChuan(Dinh1,Dinh2,Dinh3:Integer; Var 
N:ToaDo3D); 
 Var P,Q:ToaDo3D; 
 Begin 
 With hinh do 
 Begin 
 P.x:=Dinh[Dinh2].x - Dinh[Dinh1].x; 
 P.y:=Dinh[Dinh2].y - Dinh[Dinh1].y; 
 P.z:=Dinh[Dinh2].z - Dinh[Dinh1].z; 
 Q.x:=Dinh[Dinh3].x - Dinh[Dinh1].x; 
 Q.y:=Dinh[Dinh3].y - Dinh[Dinh1].y; 
 Q.z:=Dinh[Dinh3].z - Dinh[Dinh1].z; 
 N.x:=P.y*Q.z - Q.y*P.z; 
 N.y:=P.z*Q.x - Q.z*P.x; 
 N.z:=P.x*Q.y - Q.x*P.y; 
 End; 
 End; 
Function TichVoHuong(v,n:ToaDo3D):Real; 
 Begin 
 TichVoHuong:=v.x*N.x + v.y*N.y + v.z*N.z; 
 End; 
Procedure ToaDoQuanSat; 
 Begin 
 KhoiTaoPhepChieu; 
 O.x:= Rho*Aux7; 
 O.y:= Rho*Aux8; 
 O.z:= Rho*Aux2; 
 End; 
Procedure DocFile(FileName:String; Var WF:FaceModel); 
var f:Text; 
 x,i,j:Integer; 
 Begin 
 assign(f,FileName); 
 Reset(f); 
 With WF do 
 Begin 
 read(f,x); SoDinh:=x; 
 read(f,x); SoMat:=x; 
 For i:=1 to SoDinh do {Doc so dinh} 
Phụ lục. Một số chương trỡnh minh họa 
141 
 Begin 
 read(f,x); Dinh[i].x:=x; 
 read(f,x); Dinh[i].y:=x; 
 read(f,x); Dinh[i].z:=x; 
 End; 
 For i:=1 to SoMat do {Doc so Mat} 
 Begin 
 read(f,x); read(f,x); Mat[i,0]:=x; 
 For j:=1 to Mat[i,0] do 
 Begin 
 read(f,x); Mat[i,j]:=x; 
 End; 
 End; 
 End; 
 Close(f); 
 End; 
Procedure VeMat(f:Integer); 
 Var SoCanh,i,j:Integer; 
 P,P0:ToaDo3D; 
 Begin 
 With hinh do 
 Begin 
 SoCanh:=Mat[f,0]; 
 For i:=1 to SoCanh do 
 Begin 
 j:=Mat[f,i]; 
 P.x:=Dinh[j].x; P.y:=Dinh[j].y; P.z:=Dinh[j].z; 
 If i=1 Then 
 Begin 
 DiDen(P); 
 P0.x:=P.x; P0.y:=P.y; P0.z:=P.z; 
 End 
 Else VeDen(P); 
 End; 
 VeDen(P0); 
 End; 
 End; 
Procedure VeVatThe(Hinh:FaceModel); 
 Var f,Dinh1,Dinh2,Dinh3:Integer; 
 v,n:ToaDo3D; 
 Begin 
 With hinh do 
 Begin 
 For f:=1 to SoMat do 
 Begin 
 Dinh1:=Mat[f,1]; Dinh2:=Mat[f,2]; Dinh3:=Mat[f,3]; 
 VectorNhin(Dinh1,Dinh2,Dinh3,v); 
Phụ lục. Một số chương trỡnh minh họa 
142 
 VectorChuan(Dinh1,Dinh2,Dinh3,N); 
 If TichVoHuong(v,n)>0 Then 
 Begin 
 SetLineStyle(SolidLN,0,NormWidth); 
 VeMat(f); 
 End 
 Else Begin 
 SetLineStyle(DottedLN,0,NormWidth); 
 VeMat(f); 
 End; 
 End; 
 End; 
 End; 
PROCEDURE DieuKhien; 
 BEGIN 
 ToaDoQuanSat; 
 VeVatThe(Hinh); 
 Repeat 
 DieuKhienQuay; 
 ToaDoQuanSat; 
 VeVatThe(Hinh); 
 Until ch=#27; 
 END; 
BEGIN { Chuong Trinh Chinh } 
 DocFile('Batdien.txt',Hinh); 
 ThietLapDoHoa; 
 KhoiTao; 
 DieuKhien; 
 CloseGraph; 
END.