Welcome, guest! Login / Register - Why register?
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

Your Name: Code Language: