bài tập đồ họa tam giác

Vẽ tam giác
uses crt,graph;
var xa,ya,xb,yb,xc,yc,maunen,mauvien,mauto,ytop,ybottom:integer;
{----------------------khoi tao do hoa---------------------------- }
procedure Khoitao;
var gd,gm:integer;
Begin
gd:=detect;
initgraph(gd,gm,'d:\tp\bgi');
if graphresult <> grok then
Begin
writeln('Loi khoi tao do hoa, kiem tra lai duong dan');
readln;
halt(1);
End;
End;
{------------Dung Hinh----------------}
procedure DungHinh;
Begin
repeat until keypressed;
End;
{---------ket thuc do hoa----}
procedure Ketthuc;
Begin
closegraph;
End;
{-----------nhap toa do 1 diem----}
procedure nhapdiem(var x,y:integer;ch:char);
begin
writeln('Nhap toa do cho diem ',ch);
write(ch,'(x,y)= ');readln(x,y);
end;
{----------ve tam giac----------}
procedure vetamgiac(x1,y1,x2,y2,x3,y3,mv:integer);
Begin
outtextxy(x1,y1,'A');
outtextxy(x2,y2,'B');
outtextxy(x3,y3,'C');
setcolor(mv);
line(x1,y1,x2,y2);
line(x1,y1,x3,y3);
line(x2,y2,x3,y3);
End;
{----------Tim max min 3 so------------}
procedure maxmin(a,b,c:integer; var max,min:integer);
Begin
{tim max}
max:=a;
if max<b then max:=b;
if max<c then max:=c;
{tim min}
min:=a;
if min>b then min:=b;
if min>c then min:=c;
End;
{-------to mau tam giac--------------------}
procedure tomautamgiac(mv,mt,ybt,yt:integer);
var i,k,xl,xr:integer;
Begin
for k:=ybt+1 to yt-1 do
begin
for i:=0 to getmaxx do
if getpixel(i,k)=mv then
begin
xl:=i;
for i:=xl+1 to getmaxx do
if getpixel(i,k)=mv then xr:=i;
end;
for i:=xl+1 to xr-1 do putpixel(i,k,mt);
end;
End;
{-----------CHUONG TRINH CHINH------------}
BEGIN
clrscr;
nhapdiem(xa,ya,'A');
nhapdiem(xb,yb,'B');
nhapdiem(xc,yc,'C');
maunen:=3;
mauvien:=6;
mauto:=14;
khoitao;
setbkcolor(maunen);
vetamgiac(xa,ya,xb,yb,xc,yc,mauvien);
maxmin(ya,yb,yc,ytop,ybottom);
tomautamgiac(mauvien,mauto,ybottom,ytop);
dunghinh;
ketthuc;
END.

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Tô màu tam giác

uses crt,graph;
var xa,ya,xb,yb,xc,yc,maunen,mauvien,mauto,ytop,ybottom:integer;
{----------------------khoi tao do hoa---------------------------- }
procedure Khoitao;
var gd,gm:integer;
Begin
gd:=detect;
initgraph(gd,gm,'d:\tp\bgi');
if graphresult <> grok then
Begin
writeln('Loi khoi tao do hoa, kiem tra lai duong dan');
readln;
halt(1);
End;
End;
{------------Dung Hinh----------------}
procedure DungHinh;
Begin
repeat until keypressed;
End;
{---------ket thuc do hoa----}
procedure Ketthuc;
Begin
closegraph;
End;
{---------Thuat toan ve tam giac--}
procedure vetamgiac(x1,y1,x2,y2,x3,y3,m:integer);
Begin
outtextxy(x1,y1,'A');
outtextxy(x2,y2,'B');
outtextxy(x3,y3,'C');
setcolor(m);
line(x1,y1,x2,y2);
line(x1,y1,x3,y3);
line(x2,y2,x3,y3);
End;
{----------nhap toa do 1 diem----}
procedure NhapDiem(var x,y:integer;ten:char);
Begin
Writeln('Nhap toa do cho diem ',ten);
write(ten,'(x,y)=');readln(x,y);
End;

{---------to mau tam giac-----------}
procedure tomau(mv,mt,yb,yt:integer);
var i,j,k,l,r:integer;
Begin
for i:=yb+1 to yt-1 do
for j:=0 to getmaxx do
if getpixel(j,i)=mv then
begin
l:=j;
for k:=j+1 to getmaxx do
if getpixel(k,i)=mv then
begin
r:=k;
break;
end;
for k:=l+1 to r-1 do putpixel(k,i,mt);
end;
End;
{---------tim max va min----------}
procedure maxmin(a,b,c:integer;var max,min:integer);
begin
{tim max}
max:=a;
if max<b then max:=b;
if max<c then max:=c;
{tim min}
min:=a;
if min>b then min:=b;
if min>c then min:=c;
end;
{---------------CHUONG TRINH CHINH---------------------}
BEGIN
clrscr;
Nhapdiem(xa,ya,'A');
Nhapdiem(xb,yb,'B');
Nhapdiem(xc,yc,'C');
maunen:=3;
mauvien:=6;
mauto:=14;
maxmin(ya,yb,yc,ytop,ybottom);
khoitao;
setbkcolor(maunen);
vetamgiac(xa,ya,xb,yb,xc,yc,mauvien);
tomau(mauvien,mauto,ybottom,ytop);
dunghinh;
ketthuc;

END.

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Quay tam giác

uses graph, crt;
var xa,ya,xb,yb,xc,yc,xd,yd,xe,ye,xf,yf,xi,yi,ybottom,ytop,mauvien,maunen,mauto:integer;
goc:real;
{------Khoi tao do hoa--------}
procedure khoitao;
var gd,gm:integer;
Begin
gd:=detect;
initgraph(gd,gm,'d:\TP\BGI');
if graphresult <> grok then
Begin
writeln('Loi khoi tao do hoa, kiem tra duong dan');
readln;
halt(1);
End;
End;
{----dung hinh xem ket qua----}
Procedure dunghinh;
Begin
repeat until keypressed;
End;
{----Ket thuc do hoa-----}
Procedure Ketthuc;
Begin
closegraph;
End;
{-------nhap mot diem--------}
Procedure nhapdiem(var x,y:integer;ch: char);
begin
writeln('nhap toa do diem',ch);
write(ch,'(x,y)=');readln(x,y);
end;

{------ve tam giac----------}
procedure vetamgiac(x1,y1,x2,y2,x3,y3,mv: integer;d1,d2,d3:string);
Begin
outtextxy(x1,y1,d1);
outtextxy(x2,y2,d2);
outtextxy(x3,y3,d3);
setcolor(mv);
line(x1,y1,x2,y2);
line(x1,y1,x3,y3);
line(x3,y3,x2,y2);
end;
{___quay tam giac_____}
procedure quay(x,y,xr,yr:integer;goc:real;var xkq,ykq:integer);
var vao,ra:array[1..3]of integer;
matranquay: array [1..3,1..3]of real;
tam:real;
i,j:integer;
begin
vao[1]:=x;
vao[2]:=y;
vao[3]:=1;
goc:=goc*pi/180;
for i:=1 to 3 do
for j:=1 to 3 do
matranquay[i,j]:=0;
matranquay[1,1]:=cos(goc);
matranquay[2,1]:=-sin(goc);
matranquay[1,2]:=sin(goc);
matranquay[2,2]:=cos(goc);
matranquay[3,3]:=1;
matranquay[3,1]:=(1-cos(goc))*xr+sin(goc)*yr;
matranquay[3,2]:=-sin(goc)*xr+(1-cos(goc))*yr;
for i:=1 to 3 do
begin
tam:=0;
for j:=1 to 3 do
tam:=tam+vao[j]* matranquay[j,i];
ra[i]:= round(tam);
end;
xkq:=ra[1];
ykq:=ra[2];
end;
{****nhap tam quay******}
procedure nhapquay(var xtam,ytam:integer;ch:char;var g:real);
begin
writeln('nhap tam quay:',ch);
write('I(x,y):');
readln(xtam,ytam);
write('nhap goc quay');readln(g);
end;

{*******to mau tam giac**********}
procedure tomau(mv,mt,ybt,yt:integer);
var i,k,xl,xr:integer;
begin
for k:=ybt+1 to yt-1 do
begin
for i:=0 to getmaxx do
if getpixel(i,k)=mv then
begin
xl:=i;
for i:=xl+1 to getmaxx do
if getpixel (i,k)=mv then xr:=i;
end;
for i:=xl+1 to xr-1 do putpixel(i,k,mt);
end;
end;

{******chuong trinh chinh*********}
begin
clrscr;
nhapdiem(xa,ya,'A');
nhapdiem(xb,yb,'B');
nhapdiem(xc,yc,'C');
nhapquay(xi,yi,'I',goc);
maunen:=1;
mauvien:=6;
mauto:=4;
khoitao;
setbkcolor(maunen);
vetamgiac(xa,ya,xb,yb,xc,yc,mauvien,'A','B','C');
quay(xa,ya,xi,yi,goc,xd,yd);
quay(xb,yb,xi,yi,goc,xe,ye);
quay(xc,yc,xi,yi,goc, xf,yf);
vetamgiac(xd,yd,xe,ye,xf,yf,red,'D','E','F');
outtextxy(xi,yi,'I');
putpixel(xi,yi,white);
dunghinh;
ketthuc;
end.
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Tịnh tiến tam giác

uses graph, crt;
var xa,ya,xb,yb,xc,yc,xd,yd,xe,ye,xf,yf,ybottom,ytop,mauvien,maunen,mauto:integer;
{------Khoi tao do hoa--------}
procedure khoitao;
var gd,gm:integer;
Begin
gd:=detect;
initgraph(gd,gm,'d:\TP\BGI');
if graphresult <> grok then
Begin
writeln('Loi khoi tao do hoa, kiem tra duong dan');
readln;
halt(1);
End;
End;
{----dung hinh xem ket qua----}
Procedure dunghinh;
Begin
repeat until keypressed;
End;
{----Ket thuc do hoa-----}
Procedure Ketthuc;
Begin
closegraph;
End;
{-------nhap mot diem--------}
Procedure nhapdiem(var x,y:integer;ch: char);
begin
writeln('nhap toa do diem',ch);
write(ch,'(x,y)=');readln(x,y);
end;

{------ve tam giac----------}
procedure vetamgiac(x1,y1,x2,y2,x3,y3,mv: integer;d1,d2,d3:string);
Begin
outtextxy(x1,y1,d1);
outtextxy(x2,y2,d2);
outtextxy(x3,y3,d3);
setcolor(mv);
line(x1,y1,x2,y2);
line(x1,y1,x3,y3);
line(x3,y3,x2,y2);
end;
{___tinh tien tam giac_____}
procedure tinhtien(x,y,tx,ty:integer;var xkq,ykq:integer);
var vao,ra:array[1..3]of integer;
matrantt: array [1..3,1..3]of integer;
i,j,tam:integer;
begin
vao[1]:=x;
vao[2]:=y;
vao[3]:=1;
for i:=1 to 3 do
for j:=1 to 3 do
matrantt[i,j]:=0;
matrantt[1,1]:=1;
matrantt[2,2]:=1;
matrantt[3,3]:=1;
matrantt[3,1]:=tx;
matrantt[3,2]:=ty;
for i:=1 to 3 do
begin
tam:=0;
for j:=1 to 3 do
tam:=tam+vao[j]* matrantt[j,i];
ra[i]:= tam;
end;
xkq:=ra[1];
ykq:=ra[2];
end;
{*******to mau tam giac**********}
procedure tomau(mv,mt,ybt,yt:integer);
var i,k,xl,xr:integer;
begin
for k:=ybt+1 to yt-1 do
begin
for i:=0 to getmaxx do
if getpixel(i,k)=mv then
begin
xl:=i;
for i:=xl+1 to getmaxx do
if getpixel (i,k)=mv then xr:=i;
end;
for i:=xl+1 to xr-1 do putpixel(i,k,mt);
end;
end;
{******chuong trinh chinh*********}
begin
clrscr;
nhapdiem(xa,ya,'A');
nhapdiem(xb,yb,'B');
nhapdiem(xc,yc,'C');
maunen:=1;
mauvien:=6;
mauto:=4;
khoitao;
setbkcolor(maunen);
vetamgiac(xa,ya,xb,yb,xc,yc,mauvien,'A','B','C');
tinhtien(xa,ya,100,50,xd,yd);
tinhtien(xb,yb,100,50,xe,ye);
tinhtien(xc,yc,100,50, xf,yf);
vetamgiac(xd,yd,xe,ye,xf,yf,red,'D','E','F');
dunghinh;
ketthuc;
end.