Получить координаты точек по заданной линии

[sanches]

Пусть дан отрезок AB, A(x1, y1) а B(x2, y2), тогда чтобы получить Y по заданному X ( X от X1 до X2 ) воспользуемся формулой (я не упрощал - лень):
y = (y1(x2 -x1) + (x - x1)(y2 - y1))/(x2 - x1)

[Rainbow]

Поищи в инете "алгоритм Брезенхама" или Брезенхема - это алгоритм построения отрезка по 2м точкам. Я реализацию на паскале видела...

[corgi]

да тебе ж sanches все написал
делаешь for по х и в нем находишь y

Код: Выделить всё

for x=x1 to x2
y = (y1(x2 -x1) + (x - x1)(y2 - y1))/(x2 - x1)
next

В итоге ты знаешь x и y а точку и сам нарисуешь
зы только в начале надо определять какая сторона длиней и по ней в цикле идти так лчше будет

[Rainbow]

Пожалуйста если можно
можете подробнее рассказать
я както не врублюсь

Алгоритм построен так, что действия происходят всегда с целыми числами и не происходит деления. Линия рисуется попиксельно. На кажном шаге выясняется направление движения - куда шагнуть по горизонтали или по вертикали.

Вот нашла специально для тебя на VB (закомментарено рисование)

Код: Выделить всё

Sub drawline(x1, y1, x2, y2)
Dim i, x, y, d, d1, d2, dx, dy, sx, sy

dx = Abs(x2 - x1)
dy = Abs(y2 - y1)

If x2 >= x1 Then
    sx = 1
Else
    sx = -1
End If

If y2 >= y1 Then
    sy = 1
Else
    sy = -1
End If

If dy <= dx Then
    d = dy * 2 - dx
    d1 = dy * 2
    d2 = (dy - dx) * 2
    'display(x1, y1) = col
   
    x = x1 + sx
    y = y1
    For i = 1 To dx
        If d > 0 Then
            d = d + d2
            y = y + sy
        Else
            d = d + d1
        End If
        'display(x, y) = col
        x = x + sx
    Next
Else
    d = dx * 2 - dy
    d1 = dx * 2
    d2 = (dx - dy) * 2
    'display(x1, y1) = col
    x = x1
    y = y1 + sy
    For i = 1 To dy
        If d > 0 Then
            d = d + d2
            x = x + sx
        Else
            d = d + d1
        End If
        'display(x, y) = col
        y = y + sy
    Next
End If
End Sub

[alibek]

Rainbow, рулез!
Только если линия будет нулевой длины (x1=x2, y1=y2), то алгоритм поставит одну точку. А вот если добавить проверку If (dx=0) And (dy = 0) Then Exit Sub, то будет пучком

[Rainbow]

Rainbow, рулез!

Только если линия будет нулевой длины (x1=x2, y1=y2), то алгоритм поставит одну точку

А разве точка - это не есть вырожденная линия? Впрочем, это уж как кому нравится

[Лёха_Virus]

ну ёлки палки... чё так усложнять то? уравнение прямой: y=kx+b
k=(y2-y1)/(x2-x1)
b=y1-kx1
=> y(x)=((y2-y1)/(x2-x1))*x+ (y1-x1*(y2-y1)/(x2-x1))
приводим к общему знаменателю и получаем:
y(x)=y1+(x-x1)(y2-y1)/(x2-x1)

ой, сори, не увидел сообщение sanches'а

[Rainbow]

ну ёлки палки... чё так усложнять то?

Ну так вот. Мне всегда представлялось, что алгоритм Брезенхама должен давать существенный выигрыш во времени по сравнению с остальными, тк все операции в нем ПРОСТЫЕ. Взявши в руки VB, написала процедурку рисования линии понятным всем способом, используя уравнение (y-y1)/(y2-y1) = (x-x1)/(x2-x1).

Вот она:

Код: Выделить всё

Sub SimpleLine(x1 As Long, y1 As Long, x2 As Long, y2 As Long)
Dim dx, dy, lb, hb, xi, yi, x As Long, y As Long

dx = Abs(x1 - x2)
dy = Abs(y1 - y2)

If dx > dy Then
    If (x2 - x1) > 0 Then
        lb = x1
        hb = x2
    Else
        lb = x2
        hb = x1
    End If
   
    For xi = lb To hb
        y = (y2 - y1) * (xi - x1) / (x2 - x1) + y1
        'Debug.Print "(" & xi & ", " & y & ")"
    Next
Else
    If (y2 - y1) > 0 Then
        lb = y1
        hb = y2
    Else
        lb = y2
        hb = y1
    End If

    For yi = lb To hb
        x = (yi - y1) * (x2 - x1) / (y2 - y1) + x1
        'Debug.Print "(" & x & ", " & yi & ")"
    Next
End If
End Sub

К моему удивлению выигрыш получился незначительный. Совсем. Хоть он и есть. Пойду писать их на С++. VB сам себе на уме, может, чего лишнего делает... (использовать Long вместо Variant пробовала - получается быстрее, но выигрыш разница во времени примерно та же)

Код проверки:

Код: Выделить всё

Dim i As Long
Dim t As Long
t = Timer()
For i = 0 To 50000
    SimpleLine 2, 3, 1001, 702
Next
Debug.Print "simple: " & Timer() - t

t = Timer()
For i = 0 To 50000
    drawline 1, 1, 1001, 702
Next
Debug.Print "drawline: " & Timer() - t

P.S. Может, я чего не так проверила?

[A.A.Z.]

Может, так?

Код: Выделить всё

Sub SimpleLine(x1 As Long, y1 As Long, x2 As Long, y2 As Long)
Dim dx, dy, lb, hb, xi, yi, x As Long, y As Long

dx = Abs(x1 - x2)
dy = Abs(y1 - y2)

If dx > dy Then
    If (x2 - x1) > 0 Then
        lb = x1
        hb = x2
    Else
        lb = x2
        hb = x1
    End If
   
    For xi = lb To hb
        y = (y2 - y1) * (xi - x1) / (x2 - x1) + y1
        'Debug.Print "(" & xi & ", " & y & ")"
    Next
Else
    If (y2 - y1) > 0 Then
        lb = y1
        hb = y2
    Else
        lb = y2
        hb = y1
    End If

    For yi = lb To hb
        x = (yi - y1) * (x2 - x1) / (y2 - y1) + x1
        'Debug.Print "(" & x & ", " & yi & ")"
    Next
End If
End Sub

Sub SimpleLine2(x1 As Long, y1 As Long, x2 As Long, y2 As Long)
Dim dx, dy, lb, hb, xi, yi, x As Long, y As Long

dx = Abs(x1 - x2)
dy = Abs(y1 - y2)

Select Case dx > dy
Case True
    Select Case (x2 - x1) > 0
    Case True
        lb = x1
        hb = x2
    Case False
        lb = x2
        hb = x1
    End Select
   
    For xi = lb To hb
        y = (y2 - y1) * (xi - x1) / (x2 - x1) + y1
        'Debug.Print "(" & xi & ", " & y & ")"
    Next
Case False
    Select Case (y2 - y1) > 0
    Case True
        lb = y1
        hb = y2
    Case False
        lb = y2
        hb = y1
    End Select

    For yi = lb To hb
        x = (yi - y1) * (x2 - x1) / (y2 - y1) + x1
        'Debug.Print "(" & x & ", " & yi & ")"
    Next
End Select
End Sub


Первая процедура Rainbow, вторая - моя

Код проверки:
(2 кнопки, одна выполняет первую, другая - вторую)

Код: Выделить всё

Private Sub Command1_Click()
Dim T#
T = Timer
SimpleLine 0, 0, 100, 100
Debug.Print Round(Timer - T, 4)
End Sub

Private Sub Command2_Click()
Dim T#
Cls
T = Timer
SimpleLine2 0, 0, 100, 100
Debug.Print Round(Timer - T, 4)
End Sub


[Rainbow]

А в чем разница?

Проверила на Си... Ну, в 2-3 раза выигрыш... И это при том, что функция исполнялась 5млн раз (все-таки си жутко быстрый...)

Так что, могу себя утешать, что познакомила вас с классическим целочисленным алгоритмом рисования прямой по 2 точкам, который дает наилучшее (? - я теперь уже во всем сомневаюсь) приближение к оригиналу.

для все еще интересующихся...
http://hardsign.hardsign.com/prog/6

[A.A.Z.]

А в чем разница?

Select Case во много раз быстрее If'а, если мне память не изменяет.

[Ennor]

Select Case во много раз быстрее If'а, если мне память не изменяет.

По определению такого быть не может - сравнение (ну по крайней мере численное) - элементарная команда проца, типа jne, например. Что-то я не слыхал про аналогичные мнемокоды для Select Case, тем более VB-шного.
2 Rainbow: А на асме не хочешь попробовать?..