Foros del Web » Programación para mayores de 30 ;) » Programación General » Visual Basic clásico »

Ayuda Urgente Porfavor Sobre Hacer Un Sudoku!!solo Tengo 5 Dias

Estas en el tema de Ayuda Urgente Porfavor Sobre Hacer Un Sudoku!!solo Tengo 5 Dias en el foro de Visual Basic clásico en Foros del Web. Hola ha todos tengo que hacer un sudoku en visual basic tengo 5 dias por hacerlo y lo tengo comenzado pero no se lo que ...
  #1 (permalink)  
Antiguo 05/02/2007, 10:24
mfc
 
Fecha de Ingreso: febrero-2007
Mensajes: 33
Antigüedad: 17 años, 3 meses
Puntos: 0
Ayuda Urgente Porfavor Sobre Hacer Un Sudoku!!solo Tengo 5 Dias

Hola ha todos tengo que hacer un sudoku en visual basic tengo 5 dias por hacerlo y lo tengo comenzado pero no se lo que falla,por favor haver si alguien que lo sepa me puede ayudar se lo voy a agradecer mucho ,bueno el programa se trata de un sudoku que solo tiene de tener un boton y cuando pulses el boton se creen sudokus completados 9x9, pues lo que se trata es cuando pulses el boton te salga otro nuevo, aqui os dejo el codigo fuente haver si me podeis ayudar:

Dim Matriz(1 To 9, 1 To 9, 1 To 9) As Boolean

Private Sub Cmd_CrearNuevo_Click()
For i = 0 To 80
Txt_Numero(i).Text = ""
Next i
End Sub


Private Sub Txt_Numero_KeyPress(Index As Integer, KeyAscii As Integer)
If (Val(Chr(KeyAscii)) < 1 Or Val(Chr(KeyAscii)) > 9) And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub

Private Sub Txt_Numero_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyLeft
If Index > 0 Then EnfocarCaja Txt_Numero(Index - 1)
Case vbKeyRight
If Index < Txt_Numero.UBound Then EnfocarCaja Txt_Numero(Index + 1)
Case vbKeyUp
If Index > 8 Then
EnfocarCaja Txt_Numero(Index - 9)
End If
Case vbKeyDown
If Index < Txt_Numero.UBound - 9 Then
EnfocarCaja Txt_Numero(Index + 9)
End If
Case vbKeyEscape
End
End Select
End Sub

Sub EnfocarCaja(Caja As TextBox)
Caja.SetFocus
Caja.SelStart = 0
Caja.SelLength = 1
End Sub

sub ArmarMatriz()
Resetear
For i = 0 To 80
y = Int(i / 9) + 1
x = (i - (y - 1) * 9) + 1
If Txt_Numero(i) <> "" Then
z = Val(Txt_Numero(i))
ProcesarTachado x, y, z
End If
Next i
End Sub

Sub Resetear()
For x = 1 To 9
For y = 1 To 9
For z = 1 To 9
Matriz(x, y, z) = True
Next z
Next y
Next x
End Sub


Sub EncontrarResueltos()
Dim Encontro As Boolean, ValorEncontrado As Integer
Encontro = False
For x = 1 To 9
For y = 1 To 9
For z = 1 To 9
If Matriz(x, y, z) Then
If Encontro Then
Encontro = False
Exit For
Else
Encontro = True
ValorEncontrado = z
End If
End If
Next z
If Encontro Then
Txt_Numero((y - 1) * 9 + x - 1).Text = CStr(ValorEncontrado)
ProcesarTachado x, y, ValorEncontrado
End If
Encontro = False
Next y
Next x
End Sub
Sub BuscarUnicos()
For i = 1 To 9
For z = 1 To 9
x = BuscarFila(i, z)
If x > 0 Then
y = i
Txt_Numero((y - 1) * 9 + x - 1).Text = z
ProcesarTachado x, y, z
End If
y = BuscarColumna(i, z)
If y > 0 Then
x = i
Txt_Numero((y - 1) * 9 + x - 1).Text = z
ProcesarTachado x, y, z
End If
For x = 1 To 6 Step 3
For y = 1 To 6 Step 3
xy = BuscarSubMatriz(x, y, z)
If xy <> "" Then
separar = Split(xy, "-")
X2 = Val(separar(0))
Y2 = Val(separar(1))
Txt_Numero((Y2 - 1) * 9 + X2 - 1).Text = z
ProcesarTachado X2, Y2, z
End If
Next y
Next x
Next z
Next i
End Sub
Function BuscarFila(y, z)
BuscarFila = False
Dim EsUnico As Boolean
EsUnico = False
For x = 1 To 9
If Matriz(x, y, z) Then
If EsUnico Then
BuscarFila = 0
Exit Function
Else
EsUnico = True
BuscarFila = x
End If
End If
Next x
End Function
Function BuscarColumna(x, z)
BuscarColumna = False
Dim EsUnico As Boolean
EsUnico = False
For y = 1 To 9
If Matriz(x, y, z) Then
If EsUnico Then
BuscarColumna = 0
Exit Function
Else
EsUnico = True
BuscarColumna = y
End If
End If
Next y
End Function
Function BuscarSubMatriz(ByVal i, ByVal j, ByVal z) As String
Dim EsUnico As Boolean
EsUnico = False
For x = i To i + 2
For y = j To j + 2
If Matriz(x, y, z) Then
If EsUnico Then
BuscarSubMatriz = ""
Exit Function
Else
EsUnico = True
BuscarSubMatriz = CStr(x) & "-" & CStr(y)
End If
End If
Next y
Next x
End Function


Sub ProcesarTachado(x, y, z)
TacharCasilla x, y, z
TacharColumna x, z
TacharFila y, z
TacharSubMatriz x, y, z
FijarNumero x, y, z
End Sub
Sub TacharCasilla(x, y, valor)
For z = 1 To 9
If valor <> z Then Matriz(x, y, z) = False
Next z
End Sub
Sub TacharColumna(x, z)
For y = 1 To 9
Matriz(x, y, z) = False
Next y
End Sub
Sub TacharFila(y, z)
For x = 1 To 9
Matriz(x, y, z) = False
Next x
End Sub
Sub TacharSubMatriz(ByVal x, ByVal y, ByVal z)
Dim XDesde As Integer, YDesde As Integer
YDesde = (Int((y - 1) / 3) * 3) + 1
XDesde = (Int((x - 1) / 3) * 3) + 1
For x = XDesde To XDesde + 2
For y = YDesde To YDesde + 2
Matriz(x, y, z) = False
Next y
Next x
End Sub
Sub FijarNumero(x, y, z)
Matriz(x, y, z) = True
End Sub

Function FinSudoku() As Boolean
FinSudoku = True
For i = 0 To Txt_Numero.UBound
If Txt_Numero(i).Text = "" Then
FinSudoku = False
Exit Function
End If
Next i
End Function
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta




La zona horaria es GMT -6. Ahora son las 04:40.