where : ibrtses delphi
Delphi - drawing/calculating lines without canvas
disclaimer
the source code of this page may not appear correctly in certain browsers
due to special characters. Have a look at the source of this HTML page
with notepad instead
Sometimes a line has to be drawn onto a control structure
which has no canvas or is a copy of a canvas. It assumes
a field where the pixels are :
MyField=array[0..width-1,0..height-1]of byte, integer;
and a procedure that sets the pixel or throws the pixels
onto a stack or .. :
putpixelproc=procedure(x,y:integer);
Note that the starting point (x1,y1) is not set. The
linewidth is 1 (one)
procedure drawline(x1,y1,x2,y2:integer;p:putpixelproc);
var x,y,dx,dy:integer;
slope:single;
first:boolean;
begin
first:=true; // the first point, p1 is not set
dx:=(x2-x1);
dy:=(y2-y1);
if (dy=0) then begin // horizontal line
x:=x1;
while (x < > x2) do begin
if not first then p(x,y1);
if (x < x2) then inc(x) else dec(x);
first:=false;
end;
end
else begin
if dx=0 then begin // vertical line
y:=y1;
while (y < > y2) do begin
if not first then p(x1,y);
if (y < y2) then inc(y) else dec(y);
first:=false;
end;
end
else begin
slope:=dy/dx;
x:=x1;y:=y1;
if (abs(slope)<1) then begin //step x
while (x < > x2) do begin
if not first then p(x,y);
if x < x2 then inc(x) else dec(x);
y:=round(y1+(x-x1)*slope);
first:=false;
end;
end
else begin //step y
while (y < > y2) do begin
if not first then p(x,y);
if y < y2 then inc(y) else dec(y);
x:=round(x1+(y-y1)/slope);
first:=false;
end;
end;
end;
end;
end;
Feedback is welcome
sponsored links
Delphi
home
last updated: 23.june.99
Copyright (99,2000) Ing.Büro R.Tschaggelar