elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Rompecabezas de Bitcoin, Medio millón USD en premios


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Reto]Punto A Punto
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Reto]Punto A Punto  (Leído 4,827 veces)
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
[Reto]Punto A Punto
« en: 15 Mayo 2011, 02:01 am »

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
  1. 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
  1. Option Explicit
  2.  
  3. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  4.  
  5. Private Type POINTAPI
  6.    X As Long
  7.    Y As Long
  8. End Type
  9.  
  10. Private Sub Form_Load()
  11.    Dim i As Long
  12.    Dim PT1 As POINTAPI
  13.    Dim PT2 As POINTAPI
  14.    Dim mPT() As POINTAPI
  15.  
  16.    Me.ScaleMode = vbPixels
  17.  
  18.    Command1.Caption = "A"
  19.    Command2.Caption = "B"
  20.  
  21.    PT1.X = Command1.Left
  22.    PT1.Y = Command1.Top
  23.  
  24.    PT2.X = Command2.Left
  25.    PT2.Y = Command2.Top
  26.  
  27.    CreatePointLine PT1, PT2, mPT
  28.  
  29.    Me.Show
  30.  
  31.    For i = 0 To UBound(mPT)
  32.        Command1.Move mPT(i).X, mPT(i).Y
  33.        DoEvents
  34.        Sleep 5
  35.    Next
  36.  
  37. End Sub
  38.  
  39.  
  40. Private Function CreatePointLine(PT1 As POINTAPI, PT2 As POINTAPI, DestPT() As POINTAPI)
  41.    Dim X As Long, Y As Long
  42.    Dim i As Long, j As Long
  43.  
  44.    X = Abs(PT2.X - PT1.X)
  45.    Y = Abs(PT2.Y - PT1.Y)
  46.  
  47.    If X > Y Then
  48.        ReDim DestPT(X)
  49.        For i = PT1.X To PT1.X + X
  50.  
  51.            If PT1.X > PT2.X Then
  52.                DestPT(j).X = PT1.X - j
  53.            Else
  54.                DestPT(j).X = PT1.X + j
  55.            End If
  56.  
  57.            If PT1.Y > PT2.Y Then
  58.                DestPT(j).Y = PT1.Y - (Y * (j * 100 / X) / 100)
  59.            Else
  60.                DestPT(j).Y = PT1.Y + (Y * (j * 100 / X) / 100)
  61.            End If
  62.            j = j + 1
  63.        Next
  64.    Else
  65.        ReDim DestPT(Y)
  66.        For i = PT1.Y To PT1.Y + Y
  67.  
  68.            If PT1.Y > PT2.Y Then
  69.                DestPT(j).Y = PT1.Y - j
  70.            Else
  71.                DestPT(j).Y = PT1.Y + j
  72.            End If
  73.  
  74.            If PT1.X > PT2.X Then
  75.                DestPT(j).X = PT1.X - (X * (j * 100 / Y) / 100)
  76.            Else
  77.                DestPT(j).X = PT1.X + (X * (j * 100 / Y) / 100)
  78.            End If
  79.            j = j + 1
  80.        Next
  81.    End If
  82. 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
  1. Option Explicit
  2. Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
  3. Private Declare Function FillRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long) As Long
  4. Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
  5. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  6. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  7. Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long
  8.  
  9. Private Type POINTAPI
  10.    x As Long
  11.    y As Long
  12. End Type
  13.  
  14. Private Sub Form_Load()
  15.    Dim i As Long
  16.    Dim PT1 As POINTAPI
  17.    Dim PT2 As POINTAPI
  18.    Dim mPT() As POINTAPI
  19.    Dim hRgn As Long
  20.  
  21.    With Me
  22.        .AutoRedraw = True
  23.        .ScaleMode = vbPixels
  24.        .Width = 10000
  25.        .Height = 10000
  26.    End With
  27.  
  28.    Command1.Move 350, 50, 32, 32: Command1.Caption = "A"
  29.    Command2.Move 400, 570, 32, 32: Command2.Caption = "B"
  30.  
  31.    hRgn = CreateRegion
  32.    FillRgn Me.hdc, hRgn, GetStockObject(4)
  33.  
  34.  
  35.    PT1.x = Command1.Left
  36.    PT1.y = Command1.Top
  37.  
  38.    PT2.x = Command2.Left
  39.    PT2.y = Command2.Top
  40.  
  41.  
  42.  
  43.    '---------- Esta función es el reto-----------
  44.    'CreatePointLine hRgn, PT1, PT2, mPT
  45.    '---------------------------------------------
  46.  
  47.    Me.Show
  48.    On Error Resume Next
  49.    For i = 0 To UBound(mPT)
  50.        Command1.Move mPT(i).x, mPT(i).y
  51.        DoEvents
  52.        Sleep 5
  53.    Next
  54.  
  55.    DeleteObject hRgn
  56. End Sub
  57.  
  58. ' La funcion del Reto
  59. Private Function CreatePointLine(ByVal hRgn As Long, PT1 As POINTAPI, PT2 As POINTAPI, DestPT() As POINTAPI) As Boolean
  60.    '---------
  61. End Function
  62.  
  63. Private Function CreateRegion() As Long
  64.    Dim PT(0 To 9) As POINTAPI
  65.  
  66.    PT(0).x = 170: PT(0).y = 203
  67.    PT(1).x = 310: PT(1).y = 287
  68.    PT(2).x = 398: PT(2).y = 192
  69.    PT(3).x = 403: PT(3).y = 301
  70.    PT(4).x = 560: PT(4).y = 217
  71.    PT(5).x = 457: PT(5).y = 375
  72.    PT(6).x = 551: PT(6).y = 506
  73.    PT(7).x = 375: PT(7).y = 425
  74.    PT(8).x = 164: PT(8).y = 492
  75.    PT(9).x = 275: PT(9).y = 339
  76.  
  77.    CreateRegion = CreatePolygonRgn(PT(0), 10, 1)
  78. End Function
  79.  

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


« Última modificación: 15 Mayo 2011, 04:37 am por LeandroA » En línea

raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: [Reto]Punto A Punto
« Respuesta #1 en: 15 Mayo 2011, 03:36 am »

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

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


En línea

LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [Reto]Punto A Punto
« Respuesta #2 en: 15 Mayo 2011, 04:46 am »

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.
En línea

seba123neo
Moderador
***
Desconectado Desconectado

Mensajes: 3.621



Ver Perfil WWW
Re: [Reto]Punto A Punto
« Respuesta #3 en: 15 Mayo 2011, 05:10 am »

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

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

"el punto" jaja.
En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [Reto]Punto A Punto
« Respuesta #4 en: 15 Mayo 2011, 17:21 pm »

Quien quiera ahorrarse un poco de trabajo ya lo tiene hecho :P
Código:
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=54237&lngWId=1
Creo que el señor Amoxys ya ha ganado el reto :laugh: :laugh:
En línea

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [Reto]Punto A Punto
« Respuesta #5 en: 16 Mayo 2011, 01:24 am »

@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!¡.
En línea

The Dark Shadow is my passion.
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [Reto]Punto A Punto
« Respuesta #6 en: 16 Mayo 2011, 19:37 pm »

Quien quiera ahorrarse un poco de trabajo ya lo tiene hecho :P
Código:
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=54237&lngWId=1
Creo que el señor Amoxys ya ha ganado el reto :laugh: :laugh:

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.
En línea

LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [Reto]Punto A Punto
« Respuesta #7 en: 16 Mayo 2011, 22:20 pm »

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

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines