18.05.2014, 11:36
|
|
Гуру
|
|
Регистрация: 09.03.2009
Адрес: На курорте, из окна вижу теплое Баренцево море. Бррр.
Сообщения: 4,721
Репутация: 52347
|
|
Вот вам процедурка возвращающая массив координат вектора:
Код:
type
TCoords = Array of TPoint;
...
procedure GetLineCoords(var Points: TCoords; x1, y1, x2, y2: Integer);
procedure Swap(var X, Y: Integer);
var T: Integer;
begin
T := X; X := Y; Y := T;
end;
function Sign(Value: Real): Integer;
begin
Result := 0;
if Value > 0 then Result := 1;
if Value < 0 then Result := -1;
end;
var
dx,dy,i,sx,sy,Check,e,x,y: Integer;
begin
dx := Abs(x1 - x2);
dy := Abs(y1 - y2);
sx := Sign(x2 - x1);
sy := Sign(y2 - y1);
x := x1;
y := y1;
Check := 0;
if dy > dx
then begin
Swap(dx, dy);
Check := 1;
end;
e := 2*dy - dx;
SetLength(Points, dx + 1);
for i := 0 to dx
do begin
Points[i] := Point(x, y);
if e >= 0
then begin
if Check = 1
then Inc(x, sx)
else Inc(y, sy);
Dec(e, 2*dx);
end;
if Check = 1
then Inc(y, sy)
else Inc(x, sx);
Inc(e, 2*dy);
end;
end;
В большей степени авторство не мое, просто слегка адаптированное под задачу.
__________________
Жизнь такова какова она есть и больше никакова.
Помогаю за спасибо.
|