DDA
uses crt,graph;
var xp,yp,xq,yq: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 doan thang DDA hsg <1--}
procedure DDA(xa,ya,xb,yb,m:integer);
var dx,dy,x1,y2: integer;
k,y1,x2:real;
Begin
outtextxy(xa-10,ya,'A');
outtextxy(xb+10,yb,'B');
dx:=xb-xa;
dy:=yb-ya;
k:=dy/dx;
if k>=0 then
if k<=1 then
Begin
y1:=ya;
for x1:=xa to xb do
Begin
putpixel(x1,round(y1),m);
y1:=y1+k;
end;
End
else
Begin
x2:=xa;
for y2:=ya to yb do
begin
putpixel(round(x2),y2,m);
x2:=x2+1/k;
end;
End;
End;
{---Bong nay------}
procedure bongnay;
var i:integer;
Begin
for i:=50 to getmaxy-51 do
begin
circle(round(getmaxx/2),i,50);
delay(10);
cleardevice;
end;
for i:=getmaxy-50 downto 50 do
begin
circle(round(getmaxx/2),i,50);
delay(10);
cleardevice;
end;
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;
{---------------CHUONG TRINH CHINH---------------------}
BEGIN
clrscr;
Nhapdiem(xp,yp,'P');
Nhapdiem(xq,yq,'Q');
khoitao;
DDA(xp,yp,xq,yq,yellow);
dunghinh;
ketthuc;
END.
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Breshenham
uses crt,graph;
var xp,yp,xq,yq: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 doan thang DDA hsg <1--}
procedure BresLine(xa,ya,xb,yb,m:integer);
var dx,dy,x,y,P: integer;
Begin
outtextxy(xa-10,ya,'A');
outtextxy(xb+10,yb,'B');
dx:=xb-xa;
dy:=yb-ya;
P:=2*dy- dx;
x:=xa;
y:=ya;
Repeat
putpixel(x,y,m);
if P<0 then P:=p+2*dy
else
begin
P:=P+2*dy-2*dx;
y:=y+1;
end;
x:=x+1;
Until x>xb;
End;
{---Bong nay------}
procedure bongnay;
var i:integer;
Begin
for i:=50 to getmaxy-51 do
begin
circle(round(getmaxx/2),i,50);
delay(10);
cleardevice;
end;
for i:=getmaxy-50 downto 50 do
begin
circle(round(getmaxx/2),i,50);
delay(10);
cleardevice;
end;
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;
{---------------CHUONG TRINH CHINH---------------------}
BEGIN
clrscr;
Nhapdiem(xp,yp,'P');
Nhapdiem(xq,yq,'Q');
khoitao;
BresLine(xp,yp,xq,yq,yellow);
dunghinh;
ketthuc;
END.
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
miDLINE
uses crt,graph;
var xp,yp,xq,yq:integer;
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!');
halt(1);
End;
End;
procedure dunghinh;
Begin
repeat until keypressed;
End;
procedure ketthuc;
Begin
closegraph;
End;
procedure nhaptoado(var x,y:integer;ch: char);
Begin
writeln('Nhap toa do cho diem ',ch);
write(ch,'(x,y)= ');readln(x,y);
End;
procedure MidLine(xa,ya,xb,yb,m:integer);
Var x,y,A,B,P:integer;
Begin
outtextxy(xa,ya,'A');
outtextxy(xb,yb,'B');
B:=-(xb-xa);
A:=yb-ya;
x:=xa;
y:=ya;
P:=2*A-B;
Repeat
putpixel(x,y,m);
if P<0 then
P:=P+A
else
Begin
P:=P+A+B;
y:=y+1;
end;
x:=x+1;
until x>xb;
End;
BEGIN
clrscr;
nhaptoado(xp,yp,'P');
nhaptoado(xq,yq,'Q');
khoitao;
MidLine(xp,yp,xq,yq,yellow);
dunghinh;
ketthuc;
END.