Visual Basic Foro

Programación => Visual Basic 6 => Mensaje iniciado por: Bazooka en Junio 26, 2014, 10:11:21 am

Título: SOLUCIONADO- Ayuda a Detectar patron de dibujo en una matriz de tablas
Publicado por: Bazooka en Junio 26, 2014, 10:11:21 am

HOLA, amigos que siempre me han ayudado, estoy queriendo desarrollar un juego y estoy Perdido como turco en la neblina.
La idea como dice el titulo es detectar cual tabla contiene un patron determinado.

Fijense en esta imagen, como esta cargado en Tablero deberia indicarme que la tabla 1 tiene el patrón establecido.
(http://www.misimagenesgratis.com.ar/images/26-06-2014 09-59-48 a.m..jpg)

Creo que en el ejemplo lo entenderán mucho mejor que si lo explico aca en el aire.


MUCHAS GRACIAS DESDE YA POR SU APORTE!!
https://mega.co.nz/#!p0E0iJYA!9jgN1kNS_rc2V6VAwJj6aRgiJvloJ4eBSq7JSt5a63U (https://mega.co.nz/#!p0E0iJYA!9jgN1kNS_rc2V6VAwJj6aRgiJvloJ4eBSq7JSt5a63U)
bazoo

Título: Re:Ayuda a Detectar patron de dibujo en una matriz de tablas
Publicado por: raul338 en Junio 26, 2014, 11:38:50 pm

Las tablas son de tamaño variable o fijo? (cuadrado, rectangular o son todas de 3x3 ?)

Título: Re:Ayuda a Detectar patron de dibujo en una matriz de tablas
Publicado por: Bazooka en Junio 27, 2014, 12:10:14 am

Cita de: raul338 en Junio 26, 2014, 11:38:50 pm

Las tablas son de tamaño variable o fijo? (cuadrado, rectangular o son todas de 3x3 ?)

Siempre sera de tamaño fijo de 5 x 5 pero por una razon de simplificar lo puse de 3 x 3


Justamente sigo tratando de crear el procedimiento pero no hay caso me esta ganando. lo pego aqui abajo

Código: [Seleccionar]

Private Sub CONTROLA()
'LA IDEA ES QUE ESTE PROCEDIMIENTO ME DEVUELVA LAS TABLAS
'QUE TIENEN EL PATRON CORRECTO DE ACUERDO A LOS NUMEROS MARCADOS
'EN EL TABLERO Y LA VERDAD NO LOGRO HACERLO POR EL MOMENTO
Dim Puntos As Byte

   For t = 1 To UBound(tabla)
      For n = 1 To UBound(patron)
        If chPatron(n).Value Then
            If chTablero(tabla(t).POS1).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If chTablero(tabla(t).POS2).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If chTablero(tabla(t).POS3).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If chTablero(tabla(t).POS4).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If chTablero(tabla(t).POS5).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If chTablero(tabla(t).POS6).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If chTablero(tabla(t).POS7).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If chTablero(tabla(t).POS8).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If chTablero(tabla(t).POS9).Value = 1 Then
                Puntos = Puntos + 1
            End If
           
            If Puntos = 3 Then
               ' List1.AddItem t
               
            End If
            'Puntos = 0
        End If
      Next n
   
                     If Puntos = ValorPatron Then
                        List1.AddItem t
                     End If
                     Puntos = 0
 
   Next
   
 
End Sub


Título: Re:Ayuda a Detectar patron de dibujo en una matriz de tablas
Publicado por: Bazooka en Junio 27, 2014, 08:12:24 pm

Please ....

Título: Re:Ayuda a Detectar patron de dibujo en una matriz de tablas
Publicado por: Bazooka en Junio 28, 2014, 06:03:43 pm

YA QUE NO ME AYUDARON!!  YO SOLO ENCONTRE LA SOLUCION!!!! JAJJA

Lo dejo por si a alguno le interesa
este es el code completo del proyecto subido!!!

Código: [Seleccionar]

Option Explicit
Option Base 1

Dim ValorPatron As Byte
Dim tablas() As String


Private Sub Command2_Click()

End Sub

Private Sub Form_Load()
Dim n As Byte

  For n = 1 To chTablero.UBound
   Me.chTablero(n).Caption = n
  Next
 
  'DIBUJO UN PATRON
  chPatron(1).Value = 1
  chPatron(5).Value = 1
  chPatron(9).Value = 1
 
  Call CargarTAblas
End Sub


Private Sub chTablero_Click(Index As Integer)
   If chTablero(Index).Value Then
      chTablero(Index).BackColor = 255
   Else
      chTablero(Index).BackColor = &H8000000F
   End If
End Sub

Private Sub Command1_Click()
   List1.Clear
   ControlTablas
End Sub

Private Sub CargarTAblas()
  ReDim tablas(1 To 3)
  tablas(1) = "01/02/03/07/08/09/12/13/14"
  tablas(2) = "01/06/07/18/19/20/27/21/30"
  tablas(3) = "03/05/08/17/13/14/24/26/28"
End Sub

Private Sub ControlTablas()
Dim n As Byte
Dim t As Byte
Dim tabla As String
Dim mat() As String

For t = 1 To UBound(tablas)
   mat = Split(tablas(t), "/")
   
   For n = 0 To UBound(mat())
         If chTablero(mat(n)).Value Then
             tabla = tabla & "1"
         Else
             tabla = tabla & "0"
         End If
   Next n
     If ComparaBitPatron(tabla) Then
         List1.AddItem "tabla " & t & " -- " & tabla
     End If
     
     tabla = ""
Next
     Label4 = tabla
     
End Sub

Private Function ComparaBitPatron(P1 As String) As Boolean
Dim mat() As String
Dim n As Byte
   
   For n = 1 To chPatron.UBound
      If chPatron(n).Value Then
         If Mid(P1, n, 1) <> "1" Then Exit Function
      End If
   Next

ComparaBitPatron = True
End Function


Private Sub chPatron_Click(Index As Integer)
Dim tmpID As String
Dim c As Byte

If chPatron(Index).Value Then
   chPatron(Index).BackColor = 8421504
Else
   chPatron(Index).BackColor = &H8000000F
End If
ValorPatron = 0
For c = 1 To chPatron.UBound
   If chPatron(c).Value Then
         ValorPatron = ValorPatron + 1
         tmpID = tmpID & "1"
   Else
         tmpID = tmpID & "0"
   End If
Next
Me.lbValorPatron = ValorPatron
lbId = tmpID

End Sub