[Reto]Punto A Punto

[LeandroA]

Buenas para darle un poco mas de emoción al foro voy a proponer un nuevo Reto, el cual lo veo super difícil, según mi punto de vista hay que usar mucha lógica, este reto va a durar un mes o menos si alguien lo resuelve.  asi que le voy a poner una chincheta hasta que se termine.

Les paso a explicar en que consiste:
Situados dos puntos "A" y "B"  debe crearse un Array de puntos (POINTAPI) desde "A" hacia "B" lo cual no es muy difícil, el reto sera que abra un obstáculo de por medio el cual debera esquivar este obstáculo sera una Región (CreateRectRgn, CreateEllipticRgn, CreateRoundRectRgn, etc) para detectar si hay colición podemos utilizar el api

Código (vb) [Seleccionar] Expandir

Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

para tener una idea mejor muestro un ejemplo (no optimizado) de como seria "el puto "A" al "B" sin el obstaculo.

(Agregar dos CommandButton a un formulario bien separados)

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Sub Form_Load()
    Dim i As Long
    Dim PT1 As POINTAPI
    Dim PT2 As POINTAPI
    Dim mPT() As POINTAPI
   
    Me.ScaleMode = vbPixels
   
    Command1.Caption = "A"
    Command2.Caption = "B"
   
    PT1.X = Command1.Left
    PT1.Y = Command1.Top
   
    PT2.X = Command2.Left
    PT2.Y = Command2.Top
   
    CreatePointLine PT1, PT2, mPT

    Me.Show
   
    For i = 0 To UBound(mPT)
        Command1.Move mPT(i).X, mPT(i).Y
        DoEvents
        Sleep 5
    Next
   
End Sub


Private Function CreatePointLine(PT1 As POINTAPI, PT2 As POINTAPI, DestPT() As POINTAPI)
    Dim X As Long, Y As Long
    Dim i As Long, j As Long
   
    X = Abs(PT2.X - PT1.X)
    Y = Abs(PT2.Y - PT1.Y)
       
    If X > Y Then
        ReDim DestPT(X)
        For i = PT1.X To PT1.X + X
       
            If PT1.X > PT2.X Then
                DestPT(j).X = PT1.X - j
            Else
                DestPT(j).X = PT1.X + j
            End If
                       
            If PT1.Y > PT2.Y Then
                DestPT(j).Y = PT1.Y - (Y * (j * 100 / X) / 100)
            Else
                DestPT(j).Y = PT1.Y + (Y * (j * 100 / X) / 100)
            End If
            j = j + 1
        Next
    Else
        ReDim DestPT(Y)
        For i = PT1.Y To PT1.Y + Y
       
            If PT1.Y > PT2.Y Then
                DestPT(j).Y = PT1.Y - j
            Else
                DestPT(j).Y = PT1.Y + j
            End If

            If PT1.X > PT2.X Then
                DestPT(j).X = PT1.X - (X * (j * 100 / Y) / 100)
            Else
                DestPT(j).X = PT1.X + (X * (j * 100 / Y) / 100)
            End If
            j = j + 1
        Next
    End If
End Function

como ven crea un array de puntos de "A" hasta "B" ahora les dejo un prototipo para empezar a crear una funcion similar con una Region la cual devera esquivar para poder llegar al punto "B"

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Sub Form_Load()
    Dim i As Long
    Dim PT1 As POINTAPI
    Dim PT2 As POINTAPI
    Dim mPT() As POINTAPI
    Dim hRgn As Long
   
    With Me
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .Width = 10000
        .Height = 10000
    End With
   
    Command1.Move 350, 50, 32, 32: Command1.Caption = "A"
    Command2.Move 400, 570, 32, 32: Command2.Caption = "B"
   
    hRgn = CreateRegion
    FillRgn Me.hdc, hRgn, GetStockObject(4)
   
   
    PT1.x = Command1.Left
    PT1.y = Command1.Top
   
    PT2.x = Command2.Left
    PT2.y = Command2.Top
   
   
   
    '---------- Esta función es el reto-----------
    'CreatePointLine hRgn, PT1, PT2, mPT
    '---------------------------------------------

    Me.Show
    On Error Resume Next
    For i = 0 To UBound(mPT)
        Command1.Move mPT(i).x, mPT(i).y
        DoEvents
        Sleep 5
    Next
   
    DeleteObject hRgn
End Sub

' La funcion del Reto
Private Function CreatePointLine(ByVal hRgn As Long, PT1 As POINTAPI, PT2 As POINTAPI, DestPT() As POINTAPI) As Boolean
    '---------
End Function

Private Function CreateRegion() As Long
    Dim PT(0 To 9) As POINTAPI
   
    PT(0).x = 170: PT(0).y = 203
    PT(1).x = 310: PT(1).y = 287
    PT(2).x = 398: PT(2).y = 192
    PT(3).x = 403: PT(3).y = 301
    PT(4).x = 560: PT(4).y = 217
    PT(5).x = 457: PT(5).y = 375
    PT(6).x = 551: PT(6).y = 506
    PT(7).x = 375: PT(7).y = 425
    PT(8).x = 164: PT(8).y = 492
    PT(9).x = 275: PT(9).y = 339

    CreateRegion = CreatePolygonRgn(PT(0), 10, 1)
End Function


Aqui una imagen de lo que deberia hacer



para culminar, el objetivo es tratar de que funcione, luego se evaluara la velocidad en generar el array, y cual es la que genere el array mas preciso para llegar del punto A al B

[raul338]

En lugar de POINTAPY es POINT o POINTAPI (la verdad nunca supe porque le pusieron API al final )

Yo me apunto solo que... aunque supongo que no se competira por velocidad de ejecucion, sino por simpleza del camino encontrado no?

[LeandroA]

Huy que bruto puse POINTAPY, ya lo corregí, supongo que le ponen API al final para no chocar con algunas clases privadas en algunos lenguajes.
la velocidad es secundario por el momento, ya que es muy dificil el reto de lograrlo, sobre todo cuando uno piensa en todas las posiciones del punto A con respecto al B y las diferentes formas y posicion de la region.
yo por el momento no doy con ninguna solucion.

[seba123neo]

esta bueno che, solo una corrección que me hizo reir:

de como seria "el puto "A" al "B" sin el obstaculo.

"el punto" jaja.

[Karcrack]

Quien quiera ahorrarse un poco de trabajo ya lo tiene hecho

Código [Seleccionar] Expandir

http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=54237&lngWId=1
Creo que el señor Amoxys ya ha ganado el reto

[BlackZeroX]

@Karcrack

Recuerdo haber vist otro de un laberinto aun mas complejo, de hecho el laberinto se armaba solo y se respondia de manera automatizada. no recuerdo si fue en psc o en mnet lo que si se es que ya tiene mucho tiempo que lo vi. aun asi este es un reto y esperemos que no decaiga, por que es interesante!¡.

Dulces Lunas!¡.

[LeandroA]

Quien quiera ahorrarse un poco de trabajo ya lo tiene hecho

Código [Seleccionar] Expandir

http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=54237&lngWId=1
Creo que el señor Amoxys ya ha ganado el reto

Hola he revisado el codigo y esta muy bueno, es casi lo que dice el reto o almenos la idea principal, pero solo funcionaria con Regiones de poligonos con una clase interna que maneja los x, y de cada linea, ahora que pasaria si la region es un CreateEllipticRgn, la verdad como dije en un principio es vastante complicado, no probe aun pero quizas tomando como ejemplo dicho surce y creando un array de point en base a una región (GetRegionData) se pueda hacer.

[LeandroA]

Bueno quien mas si no era LaVolpe 
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=61062&lngWId=1