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

A(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.