Показать сообщение отдельно
  #8  
Старый 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;
В большей степени авторство не мое, просто слегка адаптированное под задачу.
__________________
Жизнь такова какова она есть и больше никакова.
Помогаю за спасибо.
Ответить с цитированием