admin
Administrators
Tổng số bài gửi : 39
Points : 147
Reputation : 0
Join date : 04/09/2010
Age : 32
Đến từ : nam định
 | |  TT_XÉN CẮT(ĐHMT) | |
program cohen;
uses graph;
type code = array[1..4] of byte;
var
a1,b1,a2,b2:real;
n,i,xmin,ymin,xmax,ymax,gd,gm:integer;
b:code;
procedure special_line(x1,y1,x2,y2:real);
var tg:real;
begin
if(x1=x2) and (x1>xmin) and (x1 begin
if y1>y2 then
begin
tg:=y1;
y1:=y2;
y2:=tg;
end;
if(y1ymin) then
begin
if y1 if y2>ymax then y2:=ymax;
end;
line(round(x1), round(y1), round(x2), round(y2));
end;
if(y1=y2) and (y1>ymin) and (y1 begin
if x1>x2 then
begin
tg:=x1;
x1:=x2;
x2:=tg;
end;
if(x1xmin) then
begin
if x1 if x2>xmax then x2:=xmax;
end;
line(round(x1), round(y1), round(x2), round(y2));
end;
end;
procedure kod(x,y:real;var b:code);
begin
for i:=1 to 4 do b[i]:=0;
if (x if (x>xmax) then b[2]:=1;
if (y if (y>ymax) then b[4]:=1;
end;
procedure cohen_sutherland_clipping(x1,y1,x2,y2:real);
var c1,c2:code;
chon,tong1,tong2,mu2:byte;
tgx,tgy:real;
begin
repeat
kod(x1,y1,c1);kod(x2,y2,c2);
tong1:=0; tong2:=0; mu2:=1;
for i:=1 to 4 do
begin
tong1:=tong1+c1[i]*mu2;
tong2:=tong2+c2[i]*mu2;
mu2:=mu2*2;
end;
if tong1+tong2=0 then
begin
chon:=1;
line(round(x1), round(y1), round(x2), round(y2));
end
else
if(tong1 and tong2)<>0 then
begin
chon:=2;
end
else
begin
chon:=3;
if tong1=0 then
begin
tgx:=x1; x1:=x2; x2:=tgx;
tgy:=y1; y1:=y2; y2:=tgy;
end;
kod(x1,y1,b);
if b[1]=1 then
begin
y1:=y1+(xmin-x1)*(y2-y1)/(x2-x1);x1:=xmin;
end;
if b[2]=1 then
begin
y1:=y1+(xmax-x1)*(y2-y1)/(x2-x1);x1:=xmax;
end;
if b[3]=1 then
begin
x1:=x1+(ymin-y1)*(x2-x1)/(y2-y1);y1:=ymin;
end;
if b[4]=1 then
begin
x1:=x1+(ymax-y1)*(x2-x1)/(y2-y1);y1:=ymax;
end;
end;
until (chon=1) or (chon=2)
end;
begin
write('xmin= ');readln(xmin);
write('ymin= ');readln(ymin);
write('xmax= ');readln(xmax);
write('ymax= ');readln(ymax);
write('a1= ');readln(a1);
write('b1= ');readln(b1);
write('a2= ');readln(a2);
write('b2= ');readln(b2);
gd:=detect;
initgraph(gd,gm,' ');
setcolor(3);
rectangle(xmin,ymin,xmax,ymax);
setcolor(15);
if(a1<>a2) and(b1<>b2) then
cohen_sutherland_clipping(a1,b1,a2,b2)
else
special_line(a1,b1,a2,b2);
readln;
closegraph;
end.
| |
|
