Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted by cosm ( 17 years ago )
program BresenhemLine;
{ Straight line equation is f(X) = Kx +C, where K is Z parameter from Bresenhem }
{ so to compare Z we need just compare K-parameter }
uses Crt, Graph;
var inx1, iny1, inx2, iny2: integer;
var counter: integer;
procedure initGraphics;
var
grDriver : word;
grMode : word;
errCode : integer;
begin
grDriver := Detect;
InitGraph(grDriver,grMode,'C:\tp7\BIN\');
errCode := GraphResult;
if errCode <> grOk then writeln('Couldn"t init graphics');
setTextStyle(GothicFont, HorizDir, 2);
outTextXY(1, 1, 'Bresenhem line');
end;
procedure swap(var coord1, coord2: integer);
var temp: integer;
begin
temp :=coord1;
coord1 :=coord2;
coord2 :=temp;
end;
procedure drawLine(var x1, y1, x2, y2: integer);
var currentx, currenty:integer;
delta: real;
begin
Circle(x1, y1, 2);
Circle(x2, y2, 2);
if (abs(x2-x1)>abs(y2-y1)) then { if delta X longer then Y so bigger step is on X }
begin
WriteLn('Horizontal');
if(x2-x1) <0 then
begin
swap(x2, x1); swap(y2,y1); { swapping for drawign from left to right }
end;
delta := abs((y2-y1)/(x2-x1));
currentx := x1; currenty:= y1;
while currentx <=x2 do { drawing from left to right }
begin
putPixel(currentx,currenty,15);
inc(currentx);
if currentx =x2 then putPixel(x2, y2, 15){ last pixel, dividing by zero }
else
begin
if y2-y1 >0 then while(abs((y2 -currenty)/ (x2-currentx))> delta) do inc(currenty) { drawing from top to bottom}
else while(abs((y2 -currenty)/ (x2-currentx))> delta) do dec(currenty); { drawing from bottom to top}
end;
end;
end
else {if delta Y longer then X }
begin
WriteLn('Vertical');
if(y2-y1)<0 then { swapping to draw fron top to bottom }
begin
swap(x2, x1); swap(y2,y1);
end;
delta := abs((x2-x1)/(y2-y1));
currentx := x1; currenty:= y1;
while currenty <=y2 do { drawing from top to bottom }
begin
putPixel(currentx,currenty,15);
inc(currenty);
if currenty =y2 then putPixel(x2, y2, 15){ last pixel, dividing by zero }
else
begin
if x2-x1 >0 then while(abs((x2 -currentx)/ (y2-currenty))> delta) do inc(currentx) { drawing from left to right}
else while(abs((x2 -currentx)/ (y2-currenty))> delta) do dec(currentx); { drawing from right to left}
end;
end;
end;
end;
begin
initGraphics;
randomize;
for counter :=0 to 10 do
begin
inx1 :=random(getmaxx); iny1 :=random(getmaxy); inx2 :=random(getmaxx); iny2 :=random(getmaxy);
drawLine(inx1, iny1, inx2, iny2);
end;
repeat until keyPressed;
end.
Revise this Paste