Переход из прямоугольников через центры. Ветвление.

Язык Visual Basic на платформе .NET.

Модераторы: Ramzes, Sebas

Admiralisimys
Постоялец
Постоялец
 
Сообщения: 318
Зарегистрирован: 01.06.2009 (Пн) 10:26

Переход из прямоугольников через центры. Ветвление.

Сообщение Admiralisimys » 12.11.2010 (Пт) 15:51

Здраствуйте.
Для примера, самый простой переход из точки в точку (от одной точки по первому клику мыши по форме, до второй – по второму клику)
Код: Выделить всё
Imports System
Imports System.Drawing
Imports System.Windows.Forms

Class Form1
    Inherits Form
    Dim i As Byte = 0
    Dim apt(1) As Point
    Shared Sub Main()
        Application.Run(New Form1)
    End Sub
    Sub New()
        ForeColor = SystemColors.WindowText
    End Sub
    Protected Overrides Sub OnMouseClick(ByVal mea As MouseEventArgs)
        If i < apt.Length() Then
            apt(i) = mea.Location
            i += 1
            If i = apt.Length() Then Invalidate()
        End If
    End Sub
    Protected Overrides Sub OnPaint(ByVal pea As PaintEventArgs)
        MyBase.OnPaint(pea)
        If (i >= apt.Length()) Then
            Dim grfx As Graphics = pea.Graphics
            grfx.DrawLine(New Pen(ForeColor), apt(0), apt(1))
            i = 0
        End If
    End Sub
End Class

Для централизации двух точек код преобразуется на такой
Код: Выделить всё
Imports System
Imports System.Drawing
Imports System.Windows.Forms

Class Form1
    Inherits Form
    Dim i As Byte = 0
    Dim apt(1) As Point
    Dim dX, dY As Integer
    Shared Sub Main()
        Application.Run(New Form1)
    End Sub
    Sub New()
        dX = Me.ClientSize.Width / 5
        dY = Me.ClientSize.Height / 5
        ForeColor = SystemColors.WindowText
    End Sub
    Protected Overrides Sub OnMouseClick(ByVal mea As MouseEventArgs)
        If i < apt.Length() Then

            For iD As Integer = 0 To Me.ClientSize.Width Step dX
                If (iD <= mea.Location.X) And (mea.Location.X < iD + dX) Then
                    apt(i).X = iD + dX / 2
                    iD = Me.ClientSize.Width 'break
                End If
            Next iD

            For iD As Integer = 0 To Me.ClientSize.Height Step dY
                If (iD <= mea.Location.Y) And (mea.Location.Y < iD + dY) Then
                    apt(i).Y = iD + dY / 2
                    iD = Me.ClientSize.Height 'break
                End If
            Next iD

            i += 1
            If i = apt.Length() Then Invalidate()
        End If
    End Sub
    Protected Overrides Sub OnPaint(ByVal pea As PaintEventArgs)
        Dim grfx As Graphics = pea.Graphics
        If (i >= apt.Length()) Then
            grfx.DrawLine(New Pen(ForeColor), apt(0), apt(1))
            i = 0
        End If
        For iD As Integer = 0 To Me.ClientSize.Width Step dX
            grfx.DrawLine(New Pen(ForeColor), New Point(iD, 0), New Point(iD, Me.ClientSize.Height))
        Next iD
        For iD As Integer = 0 To Me.ClientSize.Height Step dY
            grfx.DrawLine(New Pen(ForeColor), New Point(0, iD), New Point(Me.ClientSize.Width, iD))
        Next iD
    End Sub
End Class

Переходы вертикальные, горизонтальные и диагональные всегда будут проходить через центр. В других случаях (из прямоугольников на разных прямых) этого не будет(см. скрин
WayToGo.PNG
WayToGo.PNG (885 байт) Просмотров: 1824
).

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

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

Спасибо.

FireFenix
Продвинутый гуру
Продвинутый гуру
Аватара пользователя
 
Сообщения: 1640
Зарегистрирован: 25.05.2007 (Пт) 10:24
Откуда: Mugen no Sora

Re: Переход из прямоугольников через центры. Ветвление.

Сообщение FireFenix » 12.11.2010 (Пт) 22:50

Сформулируй нормально задачу, что сделано и как не получается!
Птицей Гермеса меня называют, свои крылья пожирая... сам себя я укрощаю
私はヘルメスの鳥 私は自らの羽根を喰らい 飼い慣らされる

Admiralisimys
Постоялец
Постоялец
 
Сообщения: 318
Зарегистрирован: 01.06.2009 (Пн) 10:26

Re: Переход из прямоугольников через центры. Ветвление.

Сообщение Admiralisimys » 13.11.2010 (Сб) 0:07

В некоторых играх выделяешь персонажа, потом указываешь куда идти, тебе показывают маршрут и его доступность, персонаж начинает идти по третьему клику.
Нужно проделать тоже самое, только на форме с прямыми.
WayToGo_Animated.gif
(35.96 Кб) Скачиваний: 107

Проложить пути из пункта А в пункт Б (или наоборот, направление не важно) которые размещены в центре прямоугольников на форме, разбитой на прямоугольники. Прокладывать путь можно только из центра одного прямоугольника к другому. Проведение пути сквозь промежуточный прямоугольник не через центр не допускается.
Получается так
WayToGo2.PNG
WayToGo2.PNG (2.25 Кб) Просмотров: 1793


P.S.
В добавок к коду выше дописал ещё одну функцию ShowTheWay, однако результат не совсем тот
WayToGo3.PNG
WayToGo3.PNG (1.08 Кб) Просмотров: 1793

да и код сильно громоздкий вышел
Код: Выделить всё
Dim Some As New ArrayList()
‘…
If (i >= apt.Length()) Then
            If (ShowTheWay(apt)) Then
                Dim apt2() As Point = CType(Some.ToArray(GetType(Point)), Point())
                grfx.DrawLines(New Pen(ForeColor), apt2)
                Some.Clear()
            Else
                grfx.DrawLine(New Pen(ForeColor), apt(0), apt(1))
            End If
            i = 0
        End If
‘…
    Public Function ShowTheWay(ByRef ap() As Point) As Boolean
        If (ap(0).X = ap(1).X) Or (ap(0).Y = ap(1).Y) Then Return False

        Some.Add(ap(0))

        For x As Integer = Math.Min(ap(0).X, ap(1).X) + dX To Math.Max(ap(0).X, ap(1).X) - dX Step dX / 2
            For y As Integer = Math.Min(ap(0).Y, ap(1).Y) + dY To Math.Max(ap(0).Y, ap(1).Y) - dY Step dY / 2

                For iX As Integer = 0 To Me.ClientSize.Width Step dX
                    For iY As Integer = 0 To Me.ClientSize.Height Step dY
                        If ((iX <= x) And (x < iX + dX)) And ((iY <= y) And (y < iY + dY)) Then

                            Dim sm As Point = New Point(iX + dX / 2, iY + dY / 2)
                            If Not Some.Contains(sm) Then Some.Add(sm)

                            iX = Me.ClientSize.Width 'break
                            iY = Me.ClientSize.Height 'break

                        End If
                    Next iY
                Next iX

            Next y
        Next x

        Some.Add(ap(1))

        Return True
    End Function

Понимаю, что надо копать в сторону рекурсии, а то сейчас прохождения сквозь прямоугольники воспринимается как синусоида вокруг первоначальной линии, проведённой в скриншоте из первого поста.
В рекурсии исходную точку №1 нужно будет менять и уже от неё проверять доступность прохода через центр к конечному пункту.

iGrok
Артефакт VBStreets
Артефакт VBStreets
 
Сообщения: 4272
Зарегистрирован: 10.05.2007 (Чт) 16:11
Откуда: Сетевое сознание

Re: Переход из прямоугольников через центры. Ветвление.

Сообщение iGrok » 13.11.2010 (Сб) 0:12

label:
cli
jmp label

FireFenix
Продвинутый гуру
Продвинутый гуру
Аватара пользователя
 
Сообщения: 1640
Зарегистрирован: 25.05.2007 (Пт) 10:24
Откуда: Mugen no Sora

Re: Переход из прямоугольников через центры. Ветвление.

Сообщение FireFenix » 13.11.2010 (Сб) 12:18

Ммм... А что мешает, используя координаты "неправильной линии", узнать какие блоки она пересекает и провести линию через центры этих блоков?

Вместо Dim Some As New ArrayList(), лучше юзать Dim Some as New List(Of Type)
Вместо CType() - DirectCast() или TryCast()
Птицей Гермеса меня называют, свои крылья пожирая... сам себя я укрощаю
私はヘルメスの鳥 私は自らの羽根を喰らい 飼い慣らされる

Admiralisimys
Постоялец
Постоялец
 
Сообщения: 318
Зарегистрирован: 01.06.2009 (Пн) 10:26

Re: Переход из прямоугольников через центры. Ветвление.

Сообщение Admiralisimys » 13.11.2010 (Сб) 19:13

Да iGrok очевидно это оно, не знал как правильно этот термин.
FireFenix собственно проверка прохождение через блоки и организуется в функции ShowTheWay.

Благодаря рекурсии всё оказалось намного проще
Код: Выделить всё
Imports System
Imports System.Drawing
Imports System.Windows.Forms

Class Form1
    Inherits Form
    Dim i As Byte = 0
    Dim apt(1) As Point
    Dim dX, dY As Integer
    Shared Sub Main()
        Application.Run(New Form1)
    End Sub
    Sub New()
        dX = Me.ClientSize.Width / 5
        dY = Me.ClientSize.Height / 5
        ForeColor = SystemColors.WindowText
    End Sub
    Protected Overrides Sub OnMouseClick(ByVal mea As MouseEventArgs)
        If i < apt.Length() Then

            For iD As Integer = 0 To Me.ClientSize.Width Step dX
                If (iD <= mea.Location.X) And (mea.Location.X < iD + dX) Then
                    apt(i).X = iD + dX / 2
                    iD = Me.ClientSize.Width 'break
                End If
            Next iD

            For iD As Integer = 0 To Me.ClientSize.Height Step dY
                If (iD <= mea.Location.Y) And (mea.Location.Y < iD + dY) Then
                    apt(i).Y = iD + dY / 2
                    iD = Me.ClientSize.Height 'break
                End If
            Next iD

            i += 1
            If i = apt.Length() Then Invalidate()
        End If
    End Sub
    Protected Overrides Sub OnPaint(ByVal pea As PaintEventArgs)
        Dim grfx As Graphics = pea.Graphics
        If (i >= apt.Length()) Then

            SomeFunc(apt, grfx)

            i = 0
        End If

        For iD As Integer = 0 To Me.ClientSize.Width Step dX
            grfx.DrawLine(New Pen(ForeColor), New Point(iD, 0), New Point(iD, Me.ClientSize.Height))
        Next iD
        For iD As Integer = 0 To Me.ClientSize.Height Step dY
            grfx.DrawLine(New Pen(ForeColor), New Point(0, iD), New Point(Me.ClientSize.Width, iD))
        Next iD
    End Sub
    Private Function SomeFunc(ByVal ap() As Point, ByRef grfx As Graphics) As Boolean
        If (ap(0).X = ap(1).X Or ap(0).Y = ap(1).Y) Then
            grfx.DrawLines(New Pen(ForeColor), ap)
            Return False
        End If

        Dim BufApt(1) As Point

        BufApt(0) = ap(0)
        BufApt(1) = ap(1)

        BufApt(0).X += If(ap(0).X < ap(1).X, dX, -dX)
        BufApt(0).Y += If(ap(0).Y < ap(1).Y, dY, -dY)

        grfx.DrawLine(New Pen(ForeColor), ap(0), BufApt(0))

        Return SomeFunc(BufApt, grfx)
    End Function
End Class

Единственное что, из-за того что имеем дело с целыми числами, над которыми проводим операции деления, приложения маршрута будет не всегда оптимальным (А2-Б2).
WayToGo4.PNG
WayToGo4.PNG (1.49 Кб) Просмотров: 1773

Для устранения необходим ещё допуск в проверке If (ap(0).X = ap(1).X Or ap(0).Y = ap(1).Y) (четверти dX и dY наверное будет достаточно) или работать с вещественными координатами с дальнейшей отсеканием не целой части в данной проверки.
Обход препятствий, как оказалось не совсем тривиальная вещь, так что пока без него.

Спасибо всем за помощь.

FireFenix
Продвинутый гуру
Продвинутый гуру
Аватара пользователя
 
Сообщения: 1640
Зарегистрирован: 25.05.2007 (Пт) 10:24
Откуда: Mugen no Sora

Re: Переход из прямоугольников через центры. Ветвление.

Сообщение FireFenix » 13.11.2010 (Сб) 20:12

не всегда оптимальным (А2-Б2).

что значит не всегда и оптимальным?
Птицей Гермеса меня называют, свои крылья пожирая... сам себя я укрощаю
私はヘルメスの鳥 私は自らの羽根を喰らい 飼い慣らされる

Admiralisimys
Постоялец
Постоялец
 
Сообщения: 318
Зарегистрирован: 01.06.2009 (Пн) 10:26

Re: Переход из прямоугольников через центры. Ветвление.

Сообщение Admiralisimys » 13.11.2010 (Сб) 20:35

Не всегда, когда в силу деления в (OnMouseClick) одном блоке центр на 1 пиксель смещён в ту или другую сторону по абсциссе или/и ординате. В SomeFunc мы этого не знаем, и добавляем/отнимаем целыми dX и dY величинами.

Это (не выполнение условия ap(0).Y = ap(1).Y) хорошо видно в отладке для А2-Б2, тогда как наблюдатель на форме этого не видит: по идеи маршрут должен был сразу повернуть влево к Б2, а не на 11 часов(северо-запад) и потом на 8(юго-запад) к Б2.
Как следствие наблюдаем зигзагоподобный маршрут А2-Б2.
Поворот должен быть один раз, как в случаи А1-Б1, что есть оптимально.

Если развернуть форму на весь экран, можно получить маршрут ещё по хлеще.

P.S.
Взятие деления на 2 в OnMouseClick в функцию Math.Ceiling решает вопрос.

Math.Ceiling(dX / 2)
Math.Ceiling(dY / 2)


Вернуться в Visual Basic .NET

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 67

    TopList